summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2012-09-13 21:14:54 -0600
committerKarl Williamson <public@khwilliamson.com>2012-09-13 21:14:54 -0600
commit6720ec6068a79decfb482291f764ebdc6667131f (patch)
tree233a2c093d46c73bc151240415219e0e7ed41b11
parent5f877a7f660c7d7e9a66ea7792ec054e345c8db8 (diff)
parent4d6461409e812aecb1fa745debb6132ce8e5612d (diff)
downloadperl-6720ec6068a79decfb482291f764ebdc6667131f.tar.gz
Merge branch for mostly regen/regcharclass.pl into blead
I started this work planning to enhance regen/regcharclass.pl to accept Unicode properties as input so that some small properties used in \X could be compiled in, instead of having to be read from disk. In doing so, I saw some opportunities to move some EBCDIC dependencies down to a more basic level, thus replacing quite a few existing ones with just a couple at the lower levels. This also led to my enhancing the macros output by regcharclass.pl to be at least as good (in terms of numbers of branches, etc) as the hand-coded ones it replaces. I also spotted a few bugs in existing code that hadn't been triggered yet.
Diffstat
-rw-r--r--MANIFEST4
-rw-r--r--embed.fnc12
-rw-r--r--embed.h12
-rw-r--r--embedvar.h8
-rw-r--r--ext/B/B.xs8
-rw-r--r--intrpvar.h8
-rw-r--r--lib/Unicode/UCD.pm5
-rw-r--r--lib/unicore/mktables7
-rw-r--r--perl.h10
-rw-r--r--pp.c3
-rw-r--r--proto.h60
-rw-r--r--regcharclass.h299
-rw-r--r--regcomp.c9
-rwxr-xr-xregen/regcharclass.pl653
-rw-r--r--regen/unicode_constants.pl146
-rw-r--r--regen/utf8_strings.pl108
-rw-r--r--regexec.c153
-rw-r--r--sv.c9
-rw-r--r--unicode_constants.h46
-rw-r--r--utf8.c180
-rw-r--r--utf8.h281
-rw-r--r--utf8_strings.h30
-rw-r--r--utfebcdic.h19
-rw-r--r--x2p/a2py.c8
24 files changed, 1212 insertions, 866 deletions
diff --git a/MANIFEST b/MANIFEST
index 960b357cb1..46f29a7669 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4919,7 +4919,7 @@ regen/regcharclass.pl Generate regcharclass.h from inline data
regen/regcomp.pl Builder of regnodes.h
regen/regen_lib.pl Common file routines for generator scripts
regen/uconfig_h.pl generate uconfig.h (requires /bin/sh)
-regen/utf8_strings.pl generate utf8_strings.h
+regen/unicode_constants.pl generate unicode_constants.h
regen/warnings.pl Program to write warnings.h and lib/warnings.pm
regexec.c Regular expression evaluator
regexp.h Public declarations for the above
@@ -5555,11 +5555,11 @@ t/x2p/s2p.t See if s2p/psed work
uconfig64.sh Configuration script for microperl for LP64
uconfig.h Configuration header for microperl
uconfig.sh Configuration script for microperl
+unicode_constants.h compile-time macros for Unicode code points
universal.c The default UNIVERSAL package methods
unixish.h Defines that are assumed on Unix
utf8.c Unicode routines
utf8.h Unicode header
-utf8_strings.h compile-time macros for characters in UTF-8
utfebcdic.h Unicode on EBCDIC (UTF-EBCDIC, tr16) header
util.c Utility routines
util.h Dummy header
diff --git a/embed.fnc b/embed.fnc
index ab2cdec4b3..3313849159 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -614,7 +614,6 @@ EXp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const
#endif
#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
p |UV |_to_upper_title_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const char S_or_s
-ApRM |bool |_is_utf8_quotemeta|NN const U8 *p
#endif
Ap |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp
Amp |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp
@@ -661,16 +660,7 @@ ApR |bool |is_utf8_punct |NN const U8 *p
ApR |bool |is_utf8_xdigit |NN const U8 *p
ApR |bool |is_utf8_mark |NN const U8 *p
EXpR |bool |is_utf8_X_extend |NN const U8 *p
-EXpR |bool |is_utf8_X_prepend |NN const U8 *p
EXpR |bool |is_utf8_X_regular_begin|NN const U8 *p
-EXpR |bool |is_utf8_X_special_begin|NN const U8 *p
-EXpR |bool |is_utf8_X_L |NN const U8 *p
-EXpR |bool |is_utf8_X_RI |NN const U8 *p
-:not currently used EXpR |bool |is_utf8_X_LV |NN const U8 *p
-EXpR |bool |is_utf8_X_LVT |NN const U8 *p
-EXpR |bool |is_utf8_X_LV_LVT_V |NN const U8 *p
-EXpR |bool |is_utf8_X_T |NN const U8 *p
-EXpR |bool |is_utf8_X_V |NN const U8 *p
: Used in perly.y
p |OP* |jmaybe |NN OP *o
: Used in pp.c
@@ -2027,6 +2017,8 @@ ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim
ERsM |SV* |core_regclass_swash|NULLOK const regexp *prog \
|NN const struct regnode *node|bool doinit \
|NULLOK SV **listsvp|NULLOK SV **altsvp
+:not currently used EiR |bool |is_utf8_X_LV |NN const U8 *p
+EiR |bool |is_utf8_X_LVT |NN const U8 *p
#ifdef XXX_dmq
ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN const U8 *llim \
|NN const U8 *rlim
diff --git a/embed.h b/embed.h
index 45291f0983..3f738be816 100644
--- a/embed.h
+++ b/embed.h
@@ -789,9 +789,6 @@
#define warn_nocontext Perl_warn_nocontext
#define warner_nocontext Perl_warner_nocontext
#endif
-#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
-#define _is_utf8_quotemeta(a) Perl__is_utf8_quotemeta(aTHX_ a)
-#endif
#if defined(PERL_MAD)
#define newFORM(a,b,c) Perl_newFORM(aTHX_ a,b,c)
#define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e)
@@ -855,16 +852,8 @@
#define _is_utf8__perl_idstart(a) Perl__is_utf8__perl_idstart(aTHX_ a)
#define av_reify(a) Perl_av_reify(aTHX_ a)
#define current_re_engine() Perl_current_re_engine(aTHX)
-#define is_utf8_X_L(a) Perl_is_utf8_X_L(aTHX_ a)
-#define is_utf8_X_LVT(a) Perl_is_utf8_X_LVT(aTHX_ a)
-#define is_utf8_X_LV_LVT_V(a) Perl_is_utf8_X_LV_LVT_V(aTHX_ a)
-#define is_utf8_X_RI(a) Perl_is_utf8_X_RI(aTHX_ a)
-#define is_utf8_X_T(a) Perl_is_utf8_X_T(aTHX_ a)
-#define is_utf8_X_V(a) Perl_is_utf8_X_V(aTHX_ a)
#define is_utf8_X_extend(a) Perl_is_utf8_X_extend(aTHX_ a)
-#define is_utf8_X_prepend(a) Perl_is_utf8_X_prepend(aTHX_ a)
#define is_utf8_X_regular_begin(a) Perl_is_utf8_X_regular_begin(aTHX_ a)
-#define is_utf8_X_special_begin(a) Perl_is_utf8_X_special_begin(aTHX_ a)
#define op_clear(a) Perl_op_clear(aTHX_ a)
#define qerror(a) Perl_qerror(aTHX_ a)
#define reg_named_buff(a,b,c,d) Perl_reg_named_buff(aTHX_ a,b,c,d)
@@ -975,6 +964,7 @@
# if defined(PERL_IN_REGEXEC_C)
#define core_regclass_swash(a,b,c,d,e) S_core_regclass_swash(aTHX_ a,b,c,d,e)
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
+#define is_utf8_X_LVT(a) S_is_utf8_X_LVT(aTHX_ a)
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
#define regcppop(a) S_regcppop(aTHX_ a)
#define regcppush(a,b) S_regcppush(aTHX_ a,b)
diff --git a/embedvar.h b/embedvar.h
index 877e81161f..b9fabab437 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -353,16 +353,9 @@
#define PL_unitcheckav_save (vTHX->Iunitcheckav_save)
#define PL_unlockhook (vTHX->Iunlockhook)
#define PL_unsafe (vTHX->Iunsafe)
-#define PL_utf8_X_L (vTHX->Iutf8_X_L)
#define PL_utf8_X_LVT (vTHX->Iutf8_X_LVT)
-#define PL_utf8_X_LV_LVT_V (vTHX->Iutf8_X_LV_LVT_V)
-#define PL_utf8_X_RI (vTHX->Iutf8_X_RI)
-#define PL_utf8_X_T (vTHX->Iutf8_X_T)
-#define PL_utf8_X_V (vTHX->Iutf8_X_V)
#define PL_utf8_X_extend (vTHX->Iutf8_X_extend)
-#define PL_utf8_X_prepend (vTHX->Iutf8_X_prepend)
#define PL_utf8_X_regular_begin (vTHX->Iutf8_X_regular_begin)
-#define PL_utf8_X_special_begin (vTHX->Iutf8_X_special_begin)
#define PL_utf8_alnum (vTHX->Iutf8_alnum)
#define PL_utf8_alpha (vTHX->Iutf8_alpha)
#define PL_utf8_blank (vTHX->Iutf8_blank)
@@ -377,7 +370,6 @@
#define PL_utf8_perl_idstart (vTHX->Iutf8_perl_idstart)
#define PL_utf8_print (vTHX->Iutf8_print)
#define PL_utf8_punct (vTHX->Iutf8_punct)
-#define PL_utf8_quotemeta (vTHX->Iutf8_quotemeta)
#define PL_utf8_space (vTHX->Iutf8_space)
#define PL_utf8_tofold (vTHX->Iutf8_tofold)
#define PL_utf8_tolower (vTHX->Iutf8_tolower)
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 9200cc9eba..69c4aaed7b 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -403,11 +403,7 @@ cstring(pTHX_ SV *sv, bool perlstyle)
sv_catpvs(sstr, "\\$");
else if (perlstyle && *s == '@')
sv_catpvs(sstr, "\\@");
-#ifdef EBCDIC
else if (isPRINT(*s))
-#else
- else if (*s >= ' ' && *s < 127)
-#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpvs(sstr, "\\n");
@@ -448,11 +444,7 @@ cchar(pTHX_ SV *sv)
sv_catpvs(sstr, "\\'");
else if (c == '\\')
sv_catpvs(sstr, "\\\\");
-#ifdef EBCDIC
else if (isPRINT(c))
-#else
- else if (c >= ' ' && c < 127)
-#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (c == '\n')
sv_catpvs(sstr, "\\n");
diff --git a/intrpvar.h b/intrpvar.h
index 94b7425c10..40a6aa1e9d 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -628,19 +628,11 @@ PERLVAR(I, utf8_xdigit, SV *)
PERLVAR(I, utf8_mark, SV *)
PERLVAR(I, utf8_X_regular_begin, SV *)
PERLVAR(I, utf8_X_extend, SV *)
-PERLVAR(I, utf8_X_prepend, SV *)
-PERLVAR(I, utf8_X_special_begin, SV *)
-PERLVAR(I, utf8_X_L, SV *)
PERLVAR(I, utf8_X_LVT, SV *)
-PERLVAR(I, utf8_X_RI, SV *)
-PERLVAR(I, utf8_X_T, SV *)
-PERLVAR(I, utf8_X_V, SV *)
-PERLVAR(I, utf8_X_LV_LVT_V, SV *)
PERLVAR(I, utf8_toupper, SV *)
PERLVAR(I, utf8_totitle, SV *)
PERLVAR(I, utf8_tolower, SV *)
PERLVAR(I, utf8_tofold, SV *)
-PERLVAR(I, utf8_quotemeta, SV *)
PERLVAR(I, last_swash_hv, HV *)
PERLVAR(I, last_swash_tmps, U8 *)
PERLVAR(I, last_swash_slen, STRLEN)
diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm
index a2557d8d5a..a882ab5fc6 100644
--- a/lib/Unicode/UCD.pm
+++ b/lib/Unicode/UCD.pm
@@ -5,7 +5,7 @@ use warnings;
no warnings 'surrogate'; # surrogates can be inputs to this
use charnames ();
-our $VERSION = '0.45';
+our $VERSION = '0.46';
require Exporter;
@@ -2017,7 +2017,8 @@ by the input parameter string:
prints:
0, 1114112
-An empty list is returned if the input is unknown; the number of elements in
+If the input is unknown C<undef> is returned in scalar context; an empty-list
+in list context. If the input is known, the number of elements in
the list is returned if called in scalar context.
L<perluniprops|perluniprops/Properties accessible through \p{} and \P{}> gives
diff --git a/lib/unicore/mktables b/lib/unicore/mktables
index c13439b3b3..e779b08e8e 100644
--- a/lib/unicore/mktables
+++ b/lib/unicore/mktables
@@ -13544,7 +13544,12 @@ sub compile_perl() {
my $ri = $perl->add_match_table('_X_RI', Perl_Extension => 1,
Fate => $INTERNAL_ONLY);
- $ri += $gcb->table('RI') if $v_version ge v6.2;
+ if ($v_version ge v6.2) {
+ $ri += $gcb->table('RI');
+ }
+ else {
+ push @tables_that_may_be_empty, $ri->full_name;
+ }
my $specials_begin = $perl->add_match_table('_X_Special_Begin',
Perl_Extension => 1,
diff --git a/perl.h b/perl.h
index b299432ec4..6e18dbf3ce 100644
--- a/perl.h
+++ b/perl.h
@@ -5653,15 +5653,7 @@ extern void moncontrol(int);
/* ISO 6429 NEL - C1 control NExt Line */
/* See http://www.unicode.org/unicode/reports/tr13/ */
-#ifdef EBCDIC /* In EBCDIC NEL is just an alias for LF */
-# if '^' == 95 /* CP 1047: MVS OpenEdition - OS/390 - z/OS */
-# define NEXT_LINE_CHAR 0x15
-# else /* CDRA */
-# define NEXT_LINE_CHAR 0x25
-# endif
-#else
-# define NEXT_LINE_CHAR 0x85
-#endif
+#define NEXT_LINE_CHAR NEXT_LINE_NATIVE
/* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */
#define UNICODE_LINE_SEPA_0 0xE2
diff --git a/pp.c b/pp.c
index e1a6c78268..171201d1a9 100644
--- a/pp.c
+++ b/pp.c
@@ -29,6 +29,7 @@
#include "keywords.h"
#include "reentr.h"
+#include "regcharclass.h"
/* XXX I can't imagine anyone who doesn't have this actually _needs_
it, since pid_t is an integral type.
@@ -4041,7 +4042,7 @@ PP(pp_quotemeta)
to_quote = TRUE;
}
}
- else if (_is_utf8_quotemeta((U8 *) s)) {
+ else if (is_QUOTEMETA_high(s)) {
to_quote = TRUE;
}
diff --git a/proto.h b/proto.h
index f97fe1fbae..e44b5976f5 100644
--- a/proto.h
+++ b/proto.h
@@ -1764,66 +1764,18 @@ PERL_CALLCONV bool Perl_is_uni_xdigit_lc(pTHX_ UV c)
__attribute__warn_unused_result__
__attribute__pure__;
-PERL_CALLCONV bool Perl_is_utf8_X_L(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_L \
- assert(p)
-
-PERL_CALLCONV bool Perl_is_utf8_X_LVT(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_LVT \
- assert(p)
-
-PERL_CALLCONV bool Perl_is_utf8_X_LV_LVT_V(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_LV_LVT_V \
- assert(p)
-
-PERL_CALLCONV bool Perl_is_utf8_X_RI(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_RI \
- assert(p)
-
-PERL_CALLCONV bool Perl_is_utf8_X_T(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_T \
- assert(p)
-
-PERL_CALLCONV bool Perl_is_utf8_X_V(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_V \
- assert(p)
-
PERL_CALLCONV bool Perl_is_utf8_X_extend(pTHX_ const U8 *p)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_IS_UTF8_X_EXTEND \
assert(p)
-PERL_CALLCONV bool Perl_is_utf8_X_prepend(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND \
- assert(p)
-
PERL_CALLCONV bool Perl_is_utf8_X_regular_begin(pTHX_ const U8 *p)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_IS_UTF8_X_REGULAR_BEGIN \
assert(p)
-PERL_CALLCONV bool Perl_is_utf8_X_special_begin(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_IS_UTF8_X_SPECIAL_BEGIN \
- assert(p)
-
PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ const U8 *p)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
@@ -6800,6 +6752,12 @@ STATIC char* S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, cons
#define PERL_ARGS_ASSERT_FIND_BYCLASS \
assert(prog); assert(c); assert(s); assert(strend)
+PERL_STATIC_INLINE bool S_is_utf8_X_LVT(pTHX_ const U8 *p)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_IS_UTF8_X_LVT \
+ assert(p)
+
STATIC I32 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1)
@@ -7303,12 +7261,6 @@ STATIC U8 S_to_lower_latin1(pTHX_ const U8 c, U8 *p, STRLEN *lenp)
#endif
#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
-PERL_CALLCONV bool Perl__is_utf8_quotemeta(pTHX_ const U8 *p)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT__IS_UTF8_QUOTEMETA \
- assert(p)
-
PERL_CALLCONV UV Perl__to_upper_title_latin1(pTHX_ const U8 c, U8 *p, STRLEN *lenp, const char S_or_s)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
diff --git a/regcharclass.h b/regcharclass.h
index 0399fcaf65..f9c828d358 100644
--- a/regcharclass.h
+++ b/regcharclass.h
@@ -12,17 +12,15 @@
* Any changes made here will be lost!
*/
+
+#ifndef H_REGCHARCLASS /* Guard against nested #includes */
+#define H_REGCHARCLASS 1
+
/*
LNBREAK: Line Break: \R
"\x0D\x0A" # CRLF - Network (Windows) line ending
- 0x0A # LF | LINE FEED
- 0x0B # VT | VERTICAL TAB
- 0x0C # FF | FORM FEED
- 0x0D # CR | CARRIAGE RETURN
- 0x85 # NEL | NEXT LINE
- 0x2028 # LINE SEPARATOR
- 0x2029 # PARAGRAPH SEPARATOR
+ \p{VertSpace}
*/
/*** GENERATED CODE ***/
#define is_LNBREAK(s,is_utf8) \
@@ -33,7 +31,7 @@
( ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ( 0x85 == ((U8*)s)[0] ) )
@@ -47,7 +45,7 @@
( ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ( 0x85 == ((U8*)s)[0] ) ) \
: ((e)-(s) > 1) ? \
@@ -72,7 +70,7 @@
: ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 )
/*** GENERATED CODE ***/
@@ -84,7 +82,7 @@
: ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ((e)-(s) > 1) ? \
( ( 0x0A <= ((U8*)s)[0] && ((U8*)s)[0] <= 0x0C ) ? 1 \
@@ -118,25 +116,7 @@
/*
HORIZWS: Horizontal Whitespace: \h \H
- 0x09 # HT
- 0x20 # SPACE
- 0xa0 # NBSP
- 0x1680 # OGHAM SPACE MARK
- 0x180e # MONGOLIAN VOWEL SEPARATOR
- 0x2000 # EN QUAD
- 0x2001 # EM QUAD
- 0x2002 # EN SPACE
- 0x2003 # EM SPACE
- 0x2004 # THREE-PER-EM SPACE
- 0x2005 # FOUR-PER-EM SPACE
- 0x2006 # SIX-PER-EM SPACE
- 0x2007 # FIGURE SPACE
- 0x2008 # PUNCTUATION SPACE
- 0x2009 # THIN SPACE
- 0x200A # HAIR SPACE
- 0x202f # NARROW NO-BREAK SPACE
- 0x205f # MEDIUM MATHEMATICAL SPACE
- 0x3000 # IDEOGRAPHIC SPACE
+ \p{HorizSpace}
*/
/*** GENERATED CODE ***/
#define is_HORIZWS(s,is_utf8) \
@@ -209,7 +189,7 @@
: 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
( ( 0x80 == ((U8*)s)[1] ) ? \
- ( ( ( 0x80 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x8A ) || 0xAF == ((U8*)s)[2] ) ? 3 : 0 )\
+ ( ( ( ((U8*)s)[2] <= 0x8A ) || 0xAF == ((U8*)s)[2] ) ? 3 : 0 ) \
: ( 0x81 == ((U8*)s)[1] ) ? \
( ( 0x9F == ((U8*)s)[2] ) ? 3 : 0 ) \
: 0 ) \
@@ -272,13 +252,7 @@
/*
VERTWS: Vertical Whitespace: \v \V
- 0x0A # LF
- 0x0B # VT
- 0x0C # FF
- 0x0D # CR
- 0x85 # NEL
- 0x2028 # LINE SEPARATOR
- 0x2029 # PARAGRAPH SEPARATOR
+ \p{VertSpace}
*/
/*** GENERATED CODE ***/
#define is_VERTWS(s,is_utf8) \
@@ -287,7 +261,7 @@
( ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ( 0x85 == ((U8*)s)[0] ) )
@@ -299,7 +273,7 @@
( ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ( 0x85 == ((U8*)s)[0] ) ) \
: ((e)-(s) > 1) ? \
@@ -320,7 +294,7 @@
: ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 )
/*** GENERATED CODE ***/
@@ -330,7 +304,7 @@
: ( 0xC2 == ((U8*)s)[0] ) ? \
( ( 0x85 == ((U8*)s)[1] ) ? 2 : 0 ) \
: ( 0xE2 == ((U8*)s)[0] ) ? \
- ( ( ( 0x80 == ((U8*)s)[1] ) && ( 0xA8 == ((U8*)s)[2] || 0xA9 == ((U8*)s)[2] ) ) ? 3 : 0 )\
+ ( ( ( 0x80 == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xA8 ) ) ? 3 : 0 )\
: 0 ) \
: ((e)-(s) > 1) ? \
( ( 0x0A <= ((U8*)s)[0] && ((U8*)s)[0] <= 0x0D ) ? 1 \
@@ -358,5 +332,246 @@
( 0x2028 == cp || ( 0x2028 < cp && \
0x2029 == cp ) ) ) ) ) )
+/*
+ REPLACEMENT: Unicode REPLACEMENT CHARACTER
+
+ 0xFFFD
+*/
+/*** GENERATED CODE ***/
+#define is_REPLACEMENT_utf8_safe(s,e) \
+( ( ( ( ((e)-(s) > 2) && ( 0xEF == ((U8*)s)[0] ) ) && ( 0xBF == ((U8*)s)[1] ) ) && ( 0xBD == ((U8*)s)[2] ) ) ? 3 : 0 )
+
+/*
+ NONCHAR: Non character code points
+
+ \p{Nchar}
+*/
+/*** GENERATED CODE ***/
+#define is_NONCHAR_utf8(s) \
+( ( 0xEF == ((U8*)s)[0] ) ? \
+ ( ( 0xB7 == ((U8*)s)[1] ) ? \
+ ( ( 0x90 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xAF ) ? 3 : 0 ) \
+ : ( 0xBF == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xBE ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xF0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( 0x9F == ((U8*)s)[1] || 0xAF == ((U8*)s)[1] || 0xBF == ((U8*)s)[1] ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 )\
+: ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF3 ) ? \
+ ( ( ( ( ( ((U8*)s)[1] & 0xCF ) == 0x8F ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 )\
+: ( 0xF4 == ((U8*)s)[0] ) ? \
+ ( ( ( ( 0x8F == ((U8*)s)[1] ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 )\
+: 0 )
+
+/*
+ SURROGATE: Surrogate characters
+
+ \p{Gc=Cs}
+*/
+/*** GENERATED CODE ***/
+#define is_SURROGATE_utf8(s) \
+( ( ( 0xED == ((U8*)s)[0] ) && ( ((U8*)s)[1] >= 0xA0 ) ) ? 3 : 0 )
+
+/*
+ GCB_L: Grapheme_Cluster_Break=L
+
+ \p{_X_GCB_L}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_L_utf8(s) \
+( ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( 0x84 == ((U8*)s)[1] ) ? \
+ 3 \
+ : ( 0x85 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0x9F ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xEA == ((U8*)s)[0] ) ? \
+ ( ( ( 0xA5 == ((U8*)s)[1] ) && ( 0xA0 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xBC ) ) ? 3 : 0 )\
+: 0 )
+
+/*
+ GCB_LV_LVT_V: Grapheme_Cluster_Break=(LV or LVT or V)
+
+ \p{_X_LV_LVT_V}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_LV_LVT_V_utf8(s) \
+( ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( 0x85 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xA0 ) ? 3 : 0 ) \
+ : ( 0x86 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0xA7 ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xEA == ((U8*)s)[0] ) ? \
+ ( ( ((U8*)s)[1] >= 0xB0 ) ? \
+ 3 \
+ : 0 ) \
+: ( 0xEB == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ? \
+ 3 \
+: ( 0xED == ((U8*)s)[0] ) ? \
+ ( ( ((U8*)s)[1] <= 0x9D ) ? \
+ 3 \
+ : ( 0x9E == ((U8*)s)[1] ) ? \
+ ( ( ( ((U8*)s)[2] <= 0xA3 ) || ( ((U8*)s)[2] >= 0xB0 ) ) ? 3 : 0 ) \
+ : ( 0x9F == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0x86 ) ? 3 : 0 ) \
+ : 0 ) \
+: 0 )
+
+/*
+ GCB_Prepend: Grapheme_Cluster_Break=Prepend
+
+ \p{_X_GCB_Prepend}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_Prepend_utf8(s) \
+( 0 )
+
+/*
+ GCB_RI: Grapheme_Cluster_Break=RI
+
+ \p{_X_RI}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_RI_utf8(s) \
+( ( ( ( ( 0xF0 == ((U8*)s)[0] ) && ( 0x9F == ((U8*)s)[1] ) ) && ( 0x87 == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xA6 ) ) ? 4 : 0 )
+
+/*
+ GCB_SPECIAL_BEGIN: Grapheme_Cluster_Break=special_begins
+
+ \p{_X_Special_Begin}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_SPECIAL_BEGIN_utf8(s) \
+( ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( ( ((U8*)s)[1] & 0xFC ) == 0x84 ) ? \
+ 3 \
+ : 0 ) \
+: ( 0xEA == ((U8*)s)[0] ) ? \
+ ( ( 0xA5 == ((U8*)s)[1] ) ? \
+ ( ( 0xA0 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xBC ) ? 3 : 0 ) \
+ : ( ((U8*)s)[1] >= 0xB0 ) ? \
+ 3 \
+ : 0 ) \
+: ( 0xEB == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ? \
+ 3 \
+: ( 0xED == ((U8*)s)[0] ) ? \
+ ( ( ((U8*)s)[1] <= 0x9D ) ? \
+ 3 \
+ : ( 0x9E == ((U8*)s)[1] ) ? \
+ ( ( ( ((U8*)s)[2] <= 0xA3 ) || ( ((U8*)s)[2] >= 0xB0 ) ) ? 3 : 0 ) \
+ : ( 0x9F == ((U8*)s)[1] ) ? \
+ ( ( ( ((U8*)s)[2] <= 0x86 ) || ( 0x8B <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xBB ) ) ? 3 : 0 )\
+ : 0 ) \
+: ( 0xF0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( 0x9F == ((U8*)s)[1] ) && ( 0x87 == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xA6 ) ) ? 4 : 0 )\
+: 0 )
+
+/*
+ GCB_T: Grapheme_Cluster_Break=T
+
+ \p{_X_GCB_T}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_T_utf8(s) \
+( ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( 0x86 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xA8 ) ? 3 : 0 ) \
+ : ( 0x87 == ((U8*)s)[1] ) ? \
+ 3 \
+ : 0 ) \
+: ( 0xED == ((U8*)s)[0] ) ? \
+ ( ( ( 0x9F == ((U8*)s)[1] ) && ( 0x8B <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xBB ) ) ? 3 : 0 )\
+: 0 )
+
+/*
+ GCB_V: Grapheme_Cluster_Break=V
+
+ \p{_X_GCB_V}
+*/
+/*** GENERATED CODE ***/
+#define is_GCB_V_utf8(s) \
+( ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( 0x85 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xA0 ) ? 3 : 0 ) \
+ : ( 0x86 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0xA7 ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xED == ((U8*)s)[0] ) ? \
+ ( ( 0x9E == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xB0 ) ? 3 : 0 ) \
+ : ( 0x9F == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0x86 ) ? 3 : 0 ) \
+ : 0 ) \
+: 0 )
+
+/*
+ QUOTEMETA: Meta-characters that \Q should quote
+
+ \p{_Perl_Quotemeta}
+*/
+/*** GENERATED CODE ***/
+#define is_QUOTEMETA_high(s) \
+( ( 0xCD == ((U8*)s)[0] ) ? \
+ ( ( 0x8F == ((U8*)s)[1] ) ? 2 : 0 ) \
+: ( 0xE1 == ((U8*)s)[0] ) ? \
+ ( ( 0x85 == ((U8*)s)[1] ) ? \
+ ( ( 0x9F == ((U8*)s)[2] || 0xA0 == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : ( 0x9A == ((U8*)s)[1] ) ? \
+ ( ( 0x80 == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : ( 0x9E == ((U8*)s)[1] ) ? \
+ ( ( ( ((U8*)s)[2] & 0xFE ) == 0xB4 ) ? 3 : 0 ) \
+ : ( 0xA0 == ((U8*)s)[1] ) ? \
+ ( ( 0x8B <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x8E ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xE2 == ((U8*)s)[0] ) ? \
+ ( ( 0x80 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0xBE ) ? 3 : 0 ) \
+ : ( 0x81 == ((U8*)s)[1] ) ? \
+ ( ( ( 0x81 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x93 ) || ( 0x95 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xAF ) ) ? 3 : 0 )\
+ : ( 0x86 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0x90 ) ? 3 : 0 ) \
+ : ( 0x87 <= ((U8*)s)[1] && ((U8*)s)[1] <= 0x90 ) ? \
+ 3 \
+ : ( 0x91 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0x9F ) ? 3 : 0 ) \
+ : ( 0x94 <= ((U8*)s)[1] && ((U8*)s)[1] <= 0x9C ) ? \
+ 3 \
+ : ( 0x9D == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0xB5 ) ? 3 : 0 ) \
+ : ( 0x9E == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0x94 ) ? 3 : 0 ) \
+ : ( ( 0x9F <= ((U8*)s)[1] && ((U8*)s)[1] <= 0xAF ) || ( ((U8*)s)[1] & 0xFE ) == 0xB8 ) ?\
+ 3 \
+ : 0 ) \
+: ( 0xE3 == ((U8*)s)[0] ) ? \
+ ( ( 0x80 == ((U8*)s)[1] ) ? \
+ ( ( ( ((U8*)s)[2] <= 0x83 ) || ( 0x88 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xA0 ) || 0xB0 == ((U8*)s)[2] ) ? 3 : 0 )\
+ : ( 0x85 == ((U8*)s)[1] ) ? \
+ ( ( 0xA4 == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xEF == ((U8*)s)[0] ) ? \
+ ( ( 0xB4 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] >= 0xBE ) ? 3 : 0 ) \
+ : ( 0xB8 == ((U8*)s)[1] ) ? \
+ ( ( ((U8*)s)[2] <= 0x8F ) ? 3 : 0 ) \
+ : ( 0xB9 == ((U8*)s)[1] ) ? \
+ ( ( 0x85 == ((U8*)s)[2] || 0x86 == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : ( 0xBB == ((U8*)s)[1] ) ? \
+ ( ( 0xBF == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : ( 0xBE == ((U8*)s)[1] ) ? \
+ ( ( 0xA0 == ((U8*)s)[2] ) ? 3 : 0 ) \
+ : ( 0xBF == ((U8*)s)[1] ) ? \
+ ( ( 0xB0 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xB8 ) ? 3 : 0 ) \
+ : 0 ) \
+: ( 0xF0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( 0x9D == ((U8*)s)[1] ) && ( 0x85 == ((U8*)s)[2] ) ) && ( 0xB3 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0xBA ) ) ? 4 : 0 )\
+: ( 0xF3 == ((U8*)s)[0] ) ? \
+ ( ( 0xA0 == ((U8*)s)[1] ) ? \
+ 4 \
+ : 0 ) \
+: 0 )
+
+
+#endif /* H_REGCHARCLASS */
/* ex: set ro: */
diff --git a/regcomp.c b/regcomp.c
index 6edfb1cebf..10745e9066 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -89,7 +89,7 @@ extern const struct regexp_engine my_reg_engine;
#include "dquote_static.c"
#include "charclass_invlists.h"
#include "inline_invlist.c"
-#include "utf8_strings.h"
+#include "unicode_constants.h"
#define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
@@ -7013,9 +7013,10 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags)
* list.)
* Taking the complement (inverting) an inversion list is quite simple, if the
* first element is 0, remove it; otherwise add a 0 element at the beginning.
- * This implementation reserves an element at the beginning of each inversion list
- * to contain 0 when the list contains 0, and contains 1 otherwise. The actual
- * beginning of the list is either that element if 0, or the next one if 1.
+ * This implementation reserves an element at the beginning of each inversion
+ * list to contain 0 when the list contains 0, and contains 1 otherwise. The
+ * actual beginning of the list is either that element if 0, or the next one if
+ * 1.
*
* More about inversion lists can be found in "Unicode Demystified"
* Chapter 13 by Richard Gillam, published by Addison-Wesley.
diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl
index faf1572b7c..7d126428ef 100755
--- a/regen/regcharclass.pl
+++ b/regen/regcharclass.pl
@@ -4,11 +4,12 @@ use 5.008;
use warnings;
use warnings FATAL => 'all';
use Text::Wrap qw(wrap);
-use Encode;
use Data::Dumper;
$Data::Dumper::Useqq= 1;
our $hex_fmt= "0x%02X";
+sub ASCII_PLATFORM { (ord('A') == 65) }
+
require 'regen/regen_lib.pl';
=head1 NAME
@@ -23,36 +24,47 @@ CharClass::Matcher -- Generate C macros that match character classes efficiently
Dynamically generates macros for detecting special charclasses
in latin-1, utf8, and codepoint forms. Macros can be set to return
-the length (in bytes) of the matched codepoint, or the codepoint itself.
+the length (in bytes) of the matched codepoint, and/or the codepoint itself.
-To regenerate regcharclass.h, run this script from perl-root. No arguments
+To regenerate F<regcharclass.h>, run this script from perl-root. No arguments
are necessary.
-Using WHATEVER as an example the following macros will be produced:
+Using WHATEVER as an example the following macros can be produced, depending
+on the input parameters (how to get each is described by internal comments at
+the C<__DATA__> line):
=over 4
-=item is_WHATEVER(s,is_utf8)
+=item C<is_WHATEVER(s,is_utf8)>
-=item is_WHATEVER_safe(s,e,is_utf8)
+=item C<is_WHATEVER_safe(s,e,is_utf8)>
-Do a lookup as appropriate based on the is_utf8 flag. When possible
-comparisons involving octect<128 are done before checking the is_utf8
+Do a lookup as appropriate based on the C<is_utf8> flag. When possible
+comparisons involving octect<128 are done before checking the C<is_utf8>
flag, hopefully saving time.
-=item is_WHATEVER_utf8(s)
+The version without the C<_safe> suffix should be used only when the input is
+known to be well-formed.
+
+=item C<is_WHATEVER_utf8(s)>
-=item is_WHATEVER_utf8_safe(s,e)
+=item C<is_WHATEVER_utf8_safe(s,e)>
Do a lookup assuming the string is encoded in (normalized) UTF8.
-=item is_WHATEVER_latin1(s)
+The version without the C<_safe> suffix should be used only when the input is
+known to be well-formed.
+
+=item C<is_WHATEVER_latin1(s)>
-=item is_WHATEVER_latin1_safe(s,e)
+=item C<is_WHATEVER_latin1_safe(s,e)>
Do a lookup assuming the string is encoded in latin-1 (aka plan octets).
-=item is_WHATEVER_cp(cp)
+The version without the C<_safe> suffix should be used only when it is known
+that C<s> contains at least one character.
+
+=item C<is_WHATEVER_cp(cp)>
Check to see if the string matches a given codepoint (hypothetically a
U32). The condition is constructed as as to "break out" as early as
@@ -65,11 +77,34 @@ IOW:
Thus if the character is X+1 only two comparisons will be done. Making
matching lookups slower, but non-matching faster.
-=back
+=item C<what_len_WHATEVER_FOO(arg1, ..., len)>
+
+A variant form of each of the macro types described above can be generated, in
+which the code point is returned by the macro, and an extra parameter (in the
+final position) is added, which is a pointer for the macro to set the byte
+length of the returned code point.
-Additionally it is possible to generate C<what_> variants that return
-the codepoint read instead of the number of octets read, this can be
-done by suffixing '-cp' to the type description.
+These forms all have a C<what_len> prefix instead of the C<is_>, for example
+C<what_len_WHATEVER_safe(s,e,is_utf8,len)> and
+C<what_len_WHATEVER_utf8(s,len)>.
+
+These forms should not be used I<except> on small sets of mostly widely
+separated code points; otherwise the code generated is inefficient. For these
+cases, it is best to use the C<is_> forms, and then find the code point with
+C<utf8_to_uvchr_buf>(). This program can fail with a "deep recursion"
+message on the worst of the inappropriate sets. Examine the generated macro
+to see if it is acceptable.
+
+=item C<what_WHATEVER_FOO(arg1, ...)>
+
+A variant form of each of the C<is_> macro types described above can be generated, in
+which the code point and not the length is returned by the macro. These have
+the same caveat as L</what_len_WHATEVER_FOO(arg1, ..., len)>, plus they should
+not be used where the set contains a NULL, as 0 is returned for two different
+cases: a) the set doesn't include the input code point; b) the set does
+include it, and it is a NULL.
+
+=back
=head2 CODE FORMAT
@@ -78,7 +113,7 @@ perltidy -st -bt=1 -bbt=0 -pt=0 -sbt=1 -ce -nwls== "%f"
=head1 AUTHOR
-Author: Yves Orton (demerphq) 2007
+Author: Yves Orton (demerphq) 2007. Maintained by Perl5 Porters.
=head1 BUGS
@@ -107,14 +142,16 @@ License or the Artistic License, as specified in the README file.
# represent the string in some given encoding with specific conditions.
#
# $cp - list of codepoints that make up the string.
-# $n - list of octets that make up the string if all codepoints < 128
+# $n - list of octets that make up the string if all codepoints are invariant
+# regardless of if the string is in UTF-8 or not.
# $l - list of octets that make up the string in latin1 encoding if all
-# codepoints < 256, and at least one codepoint is >127.
-# $u - list of octets that make up the string in utf8 if any codepoint >127
+# codepoints < 256, and at least one codepoint is UTF-8 variant.
+# $u - list of octets that make up the string in utf8 if any codepoint is
+# UTF-8 variant
#
# High CP | Defined
#-----------+----------
-# 0 - 127 : $n
+# 0 - 127 : $n (127/128 are the values for ASCII platforms)
# 128 - 255 : $l, $u
# 256 - ... : $u
#
@@ -123,22 +160,33 @@ sub __uni_latin1 {
my $str= shift;
my $max= 0;
my @cp;
+ my $only_has_invariants = 1;
for my $ch ( split //, $str ) {
my $cp= ord $ch;
push @cp, $cp;
$max= $cp if $max < $cp;
+ if (! ASCII_PLATFORM && $only_has_invariants) {
+ if ($cp > 255) {
+ $only_has_invariants = 0;
+ }
+ else {
+ my $temp = chr($cp);
+ utf8::upgrade($temp);
+ my @utf8 = unpack "U0C*", $temp;
+ $only_has_invariants = (@utf8 == 1 && $utf8[0] == $cp);
+ }
+ }
}
my ( $n, $l, $u );
- if ( $max < 128 ) {
+ $only_has_invariants = $max < 128 if ASCII_PLATFORM;
+ if ($only_has_invariants) {
$n= [@cp];
} else {
$l= [@cp] if $max && $max < 256;
- my $copy= $str; # must copy string, FB_CROAK makes encode destructive
- $u= eval { Encode::encode( "utf8", $copy, Encode::FB_CROAK ) };
- # $u is utf8 but with the utf8 flag OFF
- # therefore "C*" gets us the values of the bytes involved.
- $u= [ unpack "C*", $u ] if defined $u;
+ $u= $str;
+ utf8::upgrade($u);
+ $u= [ unpack "U0C*", $u ] if defined $u;
}
return ( \@cp, $n, $l, $u );
}
@@ -224,7 +272,7 @@ sub __cond_join {
#
# Each string is then stored in the 'strs' subhash as a hash record
# made up of the results of __uni_latin1, using the keynames
-# 'low','latin1','utf8', as well as the synthesized 'LATIN1' and
+# 'low','latin1','utf8', as well as the synthesized 'LATIN1', 'high', and
# 'UTF8' which hold a merge of 'low' and their lowercase equivelents.
#
# Size data is tracked per type in the 'size' subhash.
@@ -247,23 +295,62 @@ sub new {
my $str= $txt;
if ( $str =~ /^[""]/ ) {
$str= eval $str;
- } elsif ( $str =~ /^0x/ ) {
+ } elsif ($str =~ / - /x ) { # A range: Replace this element on the
+ # list with its expansion
+ my ($lower, $upper) = $str =~ / 0x (.+?) \s* - \s* 0x (.+) /x;
+ die "Format must be like '0xDEAD - 0xBEAF'; instead was '$str'" if ! defined $lower || ! defined $upper;
+ foreach my $cp (hex $lower .. hex $upper) {
+ push @{$opt{txt}}, sprintf "0x%X", $cp;
+ }
+ next;
+ } elsif ($str =~ s/ ^ N (?= 0x ) //x ) {
+ # Otherwise undocumented, a leading N means is already in the
+ # native character set; don't convert.
$str= chr eval $str;
- } elsif ( /\S/ ) {
- die "Unparsable line: $txt\n";
- } else {
+ } elsif ( $str =~ /^0x/ ) {
+ $str= eval $str;
+
+ # Convert from Unicode/ASCII to native, if necessary
+ $str = utf8::unicode_to_native($str) if ! ASCII_PLATFORM
+ && $str <= 0xFF;
+ $str = chr $str;
+ } elsif ( $str =~ / \s* \\p \{ ( .*? ) \} /x) {
+ my $property = $1;
+ use Unicode::UCD qw(prop_invlist);
+
+ my @invlist = prop_invlist($property, '_perl_core_internal_ok');
+ if (! @invlist) {
+
+ # An empty return could mean an unknown property, or merely
+ # that it is empty. Call in scalar context to differentiate
+ my $count = prop_invlist($property, '_perl_core_internal_ok');
+ die "$property not found" unless defined $count;
+ }
+
+ # Replace this element on the list with the property's expansion
+ for (my $i = 0; $i < @invlist; $i += 2) {
+ foreach my $cp ($invlist[$i] .. $invlist[$i+1] - 1) {
+
+ # prop_invlist() returns native values; add leading 'N'
+ # to indicate that.
+ push @{$opt{txt}}, sprintf "N0x%X", $cp;
+ }
+ }
next;
+ } else {
+ die "Unparsable line: $txt\n";
}
my ( $cp, $low, $latin1, $utf8 )= __uni_latin1( $str );
my $UTF8= $low || $utf8;
my $LATIN1= $low || $latin1;
+ my $high = (scalar grep { $_ < 256 } @$cp) ? 0 : $utf8;
#die Dumper($txt,$cp,$low,$latin1,$utf8)
# if $txt=~/NEL/ or $utf8 and @$utf8>3;
- @{ $self->{strs}{$str} }{qw( str txt low utf8 latin1 cp UTF8 LATIN1 )}=
- ( $str, $txt, $low, $utf8, $latin1, $cp, $UTF8, $LATIN1 );
+ @{ $self->{strs}{$str} }{qw( str txt low utf8 latin1 high cp UTF8 LATIN1 )}=
+ ( $str, $txt, $low, $utf8, $latin1, $high, $cp, $UTF8, $LATIN1 );
my $rec= $self->{strs}{$str};
- foreach my $key ( qw(low utf8 latin1 cp UTF8 LATIN1) ) {
+ foreach my $key ( qw(low utf8 latin1 high cp UTF8 LATIN1) ) {
$self->{size}{$key}{ 0 + @{ $self->{strs}{$str}{$key} } }++
if $self->{strs}{$str}{$key};
}
@@ -308,6 +395,22 @@ sub make_trie {
return 0 + keys( %trie ) ? \%trie : undef;
}
+sub pop_count ($) {
+ my $word = shift;
+
+ # This returns a list of the positions of the bits in the input word that
+ # are 1.
+
+ my @positions;
+ my $position = 0;
+ while ($word) {
+ push @positions, $position if $word & 1;
+ $position++;
+ $word >>= 1;
+ }
+ return @positions;
+}
+
# my $optree= _optree()
#
# recursively convert a trie to an optree where every node represents
@@ -326,7 +429,7 @@ sub _optree {
$depth= 0 unless defined $depth;
my @conds= sort { $a <=> $b } grep { length $_ } keys %$trie;
- if ( $trie->{''} ) {
+ if (exists $trie->{''} ) {
if ( $ret_type eq 'cp' ) {
$else= $self->{strs}{ $trie->{''} }{cp}[0];
$else= sprintf "$self->{val_fmt}", $else if $else > 9;
@@ -454,19 +557,121 @@ sub length_optree {
return $else;
}
+sub calculate_mask(@) {
+ my @list = @_;
+ my $list_count = @list;
+
+ # Look at the input list of byte values. This routine sees if the set
+ # consisting of those bytes is exactly determinable by using a
+ # mask/compare operation. If not, it returns an empty list; if so, it
+ # returns a list consisting of (mask, compare). For example, consider a
+ # set consisting of the numbers 0xF0, 0xF1, 0xF2, and 0xF3. If we want to
+ # know if a number 'c' is in the set, we could write:
+ # 0xF0 <= c && c <= 0xF4
+ # But the following mask/compare also works, and has just one test:
+ # c & 0xFC == 0xF0
+ # The reason it works is that the set consists of exactly those numbers
+ # whose first 4 bits are 1, and the next two are 0. (The value of the
+ # other 2 bits is immaterial in determining if a number is in the set or
+ # not.) The mask masks out those 2 irrelevant bits, and the comparison
+ # makes sure that the result matches all bytes that which match those 6
+ # material bits exactly. In other words, the set of numbers contains
+ # exactly those whose bottom two bit positions are either 0 or 1. The
+ # same principle applies to bit positions that are not necessarily
+ # adjacent. And it can be applied to bytes that differ in 1 through all 8
+ # bit positions. In order to be a candidate for this optimization, the
+ # number of numbers in the test must be a power of 2. Based on this
+ # count, we know the number of bit positions that must differ.
+ my $bit_diff_count = 0;
+ my $compare = $list[0];
+ if ($list_count == 2) {
+ $bit_diff_count = 1;
+ }
+ elsif ($list_count == 4) {
+ $bit_diff_count = 2;
+ }
+ elsif ($list_count == 8) {
+ $bit_diff_count = 3;
+ }
+ elsif ($list_count == 16) {
+ $bit_diff_count = 4;
+ }
+ elsif ($list_count == 32) {
+ $bit_diff_count = 5;
+ }
+ elsif ($list_count == 64) {
+ $bit_diff_count = 6;
+ }
+ elsif ($list_count == 128) {
+ $bit_diff_count = 7;
+ }
+ elsif ($list_count == 256) {
+ return (0, 0);
+ }
+
+ # If the count wasn't a power of 2, we can't apply this optimization
+ return if ! $bit_diff_count;
+
+ my %bit_map;
+
+ # For each byte in the list, find the bit positions in it whose value
+ # differs from the first byte in the set.
+ for (my $i = 1; $i < @list; $i++) {
+ my @positions = pop_count($list[0] ^ $list[$i]);
+
+ # If the number of differing bits is greater than those permitted by
+ # the set size, this optimization doesn't apply.
+ return if @positions > $bit_diff_count;
+
+ # Save the bit positions that differ.
+ foreach my $bit (@positions) {
+ $bit_map{$bit} = 1;
+ }
+
+ # If the total so far is greater than those permitted by the set size,
+ # this optimization doesn't apply.
+ return if keys %bit_map > $bit_diff_count;
+
+
+ # The value to compare against is the AND of all the members of the
+ # set. The bit positions that are the same in all will be correct in
+ # the AND, and the bit positions that differ will be 0.
+ $compare &= $list[$i];
+ }
+
+ # To get to here, we have gone through all bytes in the set,
+ # and determined that they all differ from each other in at most
+ # the number of bits allowed for the set's quantity. And since we have
+ # tested all 2**N possibilities, we know that the set includes no fewer
+ # elements than we need,, so the optimization applies.
+ die "panic: internal logic error" if keys %bit_map != $bit_diff_count;
+
+ # The mask is the bit positions where things differ, complemented.
+ my $mask = 0;
+ foreach my $position (keys %bit_map) {
+ $mask |= 1 << $position;
+ }
+ $mask = ~$mask & 0xFF;
+
+ return ($mask, $compare);
+}
+
# _cond_as_str
# turn a list of conditions into a text expression
# - merges ranges of conditions, and joins the result with ||
sub _cond_as_str {
- my ( $self, $op, $combine )= @_;
+ my ( $self, $op, $combine, $opts_ref )= @_;
my $cond= $op->{vals};
my $test= $op->{test};
+ my $is_cp_ret = $opts_ref->{ret_type} eq "cp";
return "( $test )" if !defined $cond;
- # rangify the list
+ # rangify the list.
my @ranges;
my $Update= sub {
- if ( @ranges ) {
+ # We skip this if there are optimizations that
+ # we can apply (below) to the individual ranges
+ if ( ($is_cp_ret || $combine) && @ranges && ref $ranges[-1]) {
if ( $ranges[-1][0] == $ranges[-1][1] ) {
$ranges[-1]= $ranges[-1][0];
} elsif ( $ranges[-1][0] + 1 == $ranges[-1][1] ) {
@@ -475,25 +680,129 @@ sub _cond_as_str {
}
}
};
- for my $cond ( @$cond ) {
- if ( !@ranges || $cond != $ranges[-1][1] + 1 ) {
+ for my $condition ( @$cond ) {
+ if ( !@ranges || $condition != $ranges[-1][1] + 1 ) {
$Update->();
- push @ranges, [ $cond, $cond ];
+ push @ranges, [ $condition, $condition ];
} else {
$ranges[-1][1]++;
}
}
$Update->();
+
return $self->_combine( $test, @ranges )
if $combine;
- @ranges= map {
- ref $_
- ? sprintf(
- "( $self->{val_fmt} <= $test && $test <= $self->{val_fmt} )",
- @$_ )
- : sprintf( "$self->{val_fmt} == $test", $_ );
- } @ranges;
+
+ if ($is_cp_ret) {
+ @ranges= map {
+ ref $_
+ ? sprintf(
+ "( $self->{val_fmt} <= $test && $test <= $self->{val_fmt} )",
+ @$_ )
+ : sprintf( "$self->{val_fmt} == $test", $_ );
+ } @ranges;
+ }
+ else {
+ # If the input set has certain characteristics, we can optimize tests
+ # for it. This doesn't apply if returning the code point, as we want
+ # each element of the set individually. The code above is for this
+ # simpler case.
+
+ return 1 if @$cond == 256; # If all bytes match, is trivially true
+
+ if (@ranges > 1) {
+ # See if the entire set shares optimizable characterstics, and if
+ # so, return the optimization. We delay checking for this on sets
+ # with just a single range, as there may be better optimizations
+ # available in that case.
+ my ($mask, $base) = calculate_mask(@$cond);
+ if (defined $mask && defined $base) {
+ return sprintf "( ( $test & $self->{val_fmt} ) == $self->{val_fmt} )", $mask, $base;
+ }
+ }
+
+ # Here, there was no entire-class optimization. Look at each range.
+ for (my $i = 0; $i < @ranges; $i++) {
+ if (! ref $ranges[$i]) { # Trivial case: no range
+ $ranges[$i] = sprintf "$self->{val_fmt} == $test", $ranges[$i];
+ }
+ elsif ($ranges[$i]->[0] == $ranges[$i]->[1]) {
+ $ranges[$i] = # Trivial case: single element range
+ sprintf "$self->{val_fmt} == $test", $ranges[$i]->[0];
+ }
+ else {
+ my $output = "";
+
+ # Well-formed UTF-8 continuation bytes on ascii platforms must
+ # be in the range 0x80 .. 0xBF. If we know that the input is
+ # well-formed (indicated by not trying to be 'safe'), we can
+ # omit tests that verify that the input is within either of
+ # these bounds. (No legal UTF-8 character can begin with
+ # anything in this range, so we don't have to worry about this
+ # being a continuation byte or not.)
+ if (ASCII_PLATFORM
+ && ! $opts_ref->{safe}
+ && $opts_ref->{type} =~ / ^ (?: utf8 | high ) $ /xi)
+ {
+ my $lower_limit_is_80 = ($ranges[$i]->[0] == 0x80);
+ my $upper_limit_is_BF = ($ranges[$i]->[1] == 0xBF);
+
+ # If the range is the entire legal range, it matches any
+ # legal byte, so we can omit both tests. (This should
+ # happen only if the number of ranges is 1.)
+ if ($lower_limit_is_80 && $upper_limit_is_BF) {
+ return 1;
+ }
+ elsif ($lower_limit_is_80) { # Just use the upper limit test
+ $output = sprintf("( $test <= $self->{val_fmt} )",
+ $ranges[$i]->[1]);
+ }
+ elsif ($upper_limit_is_BF) { # Just use the lower limit test
+ $output = sprintf("( $test >= $self->{val_fmt} )",
+ $ranges[$i]->[0]);
+ }
+ }
+
+ # If we didn't change to omit a test above, see if the number
+ # of elements is a power of 2 (only a single bit in the
+ # representation of its count will be set) and if so, it may
+ # be that a mask/compare optimization is possible.
+ if ($output eq ""
+ && pop_count($ranges[$i]->[1] - $ranges[$i]->[0] + 1) == 1)
+ {
+ my @list;
+ push @list, $_ for ($ranges[$i]->[0] .. $ranges[$i]->[1]);
+ my ($mask, $base) = calculate_mask(@list);
+ if (defined $mask && defined $base) {
+ $output = sprintf "( $test & $self->{val_fmt} ) == $self->{val_fmt}", $mask, $base;
+ }
+ }
+
+ if ($output ne "") { # Prefer any optimization
+ $ranges[$i] = $output;
+ }
+ elsif ($ranges[$i]->[0] + 1 == $ranges[$i]->[1]) {
+ # No optimization happened. We need a test that the code
+ # point is within both bounds. But, if the bounds are
+ # adjacent code points, it is cleaner to say
+ # 'first == test || second == test'
+ # than it is to say
+ # 'first <= test && test <= second'
+ $ranges[$i] = "( "
+ . join( " || ", ( map
+ { sprintf "$self->{val_fmt} == $test", $_ }
+ @{$ranges[$i]} ) )
+ . " )";
+ }
+ else { # Full bounds checking
+ $ranges[$i] = sprintf("( $self->{val_fmt} <= $test && $test <= $self->{val_fmt} )", $ranges[$i]->[0], $ranges[$i]->[1]);
+ }
+ }
+ }
+ }
+
return "( " . join( " || ", @ranges ) . " )";
+
}
# _combine
@@ -524,13 +833,18 @@ sub _combine {
# _render()
# recursively convert an optree to text with reasonably neat formatting
sub _render {
- my ( $self, $op, $combine, $brace )= @_;
+ my ( $self, $op, $combine, $brace, $opts_ref )= @_;
+ return 0 if ! defined $op; # The set is empty
if ( !ref $op ) {
return $op;
}
- my $cond= $self->_cond_as_str( $op, $combine );
- my $yes= $self->_render( $op->{yes}, $combine, 1 );
- my $no= $self->_render( $op->{no}, $combine, 0 );
+ my $cond= $self->_cond_as_str( $op, $combine, $opts_ref );
+ #no warnings 'recursion'; # This would allow really really inefficient
+ # code to be generated. See pod
+ my $yes= $self->_render( $op->{yes}, $combine, 1, $opts_ref );
+ return $yes if $cond eq '1';
+
+ my $no= $self->_render( $op->{no}, $combine, 0, $opts_ref );
return "( $cond )" if $yes eq '1' and $no eq '0';
my ( $lb, $rb )= $brace ? ( "( ", " )" ) : ( "", "" );
return "$lb$cond ? $yes : $no$rb"
@@ -555,8 +869,8 @@ sub _render {
# longer lists such as that resulting from type 'cp' output.
# Currently only used for type 'cp' macros.
sub render {
- my ( $self, $op, $combine )= @_;
- my $str= "( " . $self->_render( $op, $combine ) . " )";
+ my ( $self, $op, $combine, $opts_ref )= @_;
+ my $str= "( " . $self->_render( $op, $combine, 0, $opts_ref ) . " )";
return __clean( $str );
}
@@ -564,7 +878,7 @@ sub render {
# make a macro of a given type.
# calls into make_trie and (generic_|length_)optree as needed
# Opts are:
-# type : 'cp','generic','low','latin1','utf8','LATIN1','UTF8'
+# type : 'cp','generic','high','low','latin1','utf8','LATIN1','UTF8'
# ret_type : 'cp' or 'len'
# safe : add length guards to macro
#
@@ -595,7 +909,7 @@ sub make_macro {
$method= 'optree';
}
my $optree= $self->$method( %opts, type => $type, ret_type => $ret_type );
- my $text= $self->render( $optree, $type eq 'cp' );
+ my $text= $self->render( $optree, $type eq 'cp', \%opts );
my @args= $type eq 'cp' ? 'cp' : 's';
push @args, "e" if $opts{safe};
push @args, "is_utf8" if $type eq 'generic';
@@ -626,21 +940,38 @@ if ( !caller ) {
print $out_fh read_only_top( lang => 'C', by => $0,
file => 'regcharclass.h', style => '*',
copyright => [2007, 2011] );
+ print $out_fh "\n#ifndef H_REGCHARCLASS /* Guard against nested #includes */\n#define H_REGCHARCLASS 1\n\n";
- my ( $op, $title, @txt, @types, @mods );
+ my ( $op, $title, @txt, @types, %mods );
my $doit= sub {
return unless $op;
+
+ # Skip if to compile on a different platform.
+ return if delete $mods{only_ascii_platform} && ! ASCII_PLATFORM;
+ return if delete $mods{only_ebcdic_platform} && ord 'A' != 193;
+
print $out_fh "/*\n\t$op: $title\n\n";
print $out_fh join "\n", ( map { "\t$_" } @txt ), "*/", "";
my $obj= __PACKAGE__->new( op => $op, title => $title, txt => \@txt );
- #die Dumper(\@types,\@mods);
+ #die Dumper(\@types,\%mods);
+
+ my @mods;
+ push @mods, 'safe' if delete $mods{safe};
+ unshift @mods, 'fast' if delete $mods{fast} || ! @mods; # Default to 'fast'
+ # do this one
+ # first, as
+ # traditional
+ if (%mods) {
+ die "Unknown modifiers: ", join ", ", map { "'$_'" } keys %mods;
+ }
foreach my $type_spec ( @types ) {
my ( $type, $ret )= split /-/, $type_spec;
$ret ||= 'len';
foreach my $mod ( @mods ) {
next if $mod eq 'safe' and $type eq 'cp';
+ delete $mods{$mod};
my $macro= $obj->make_macro(
type => $type,
ret_type => $ret,
@@ -652,22 +983,26 @@ if ( !caller ) {
};
while ( <DATA> ) {
- s/^\s*#//;
+ s/^ \s* (?: \# .* ) ? $ //x; # squeeze out comment and blanks
next unless /\S/;
chomp;
if ( /^([A-Z]+)/ ) {
- $doit->();
+ $doit->(); # This starts a new definition; do the previous one
( $op, $title )= split /\s*:\s*/, $_, 2;
@txt= ();
} elsif ( s/^=>// ) {
my ( $type, $modifier )= split /:/, $_;
@types= split ' ', $type;
- @mods= split ' ', $modifier;
+ undef %mods;
+ map { $mods{$_} = 1 } split ' ', $modifier;
} else {
push @txt, "$_";
}
}
$doit->();
+
+ print $out_fh "\n#endif /* H_REGCHARCLASS */\n";
+
if($path eq '-') {
print $out_fh "/* ex: set ro: */\n";
} else {
@@ -675,16 +1010,95 @@ if ( !caller ) {
}
}
+# The form of the input is a series of definitions to make macros for.
+# The first line gives the base name of the macro, followed by a colon, and
+# then text to be used in comments associated with the macro that are its
+# title or description. In all cases the first (perhaps only) parameter to
+# the macro is a pointer to the first byte of the code point it is to test to
+# see if it is in the class determined by the macro. In the case of non-UTF8,
+# the code point consists only of a single byte.
#
-# Valid types: generic, LATIN1, UTF8, low, latin1, utf8
-# default return value is octects read.
-# append -cp to make it codepoint matched.
-# modifiers come after the colon, valid possibilities
-# being 'fast' and 'safe'.
+# The second line must begin with a '=>' and be followed by the types of
+# macro(s) to be generated; these are specified below. A colon follows the
+# types, followed by the modifiers, also specified below. At least one
+# modifier is required.
#
+# The subsequent lines give what code points go into the class defined by the
+# macro. Multiple characters may be specified via a string like "\x0D\x0A",
+# enclosed in quotes. Otherwise the lines consist of single Unicode code
+# point, prefaced by 0x; or a single range of Unicode code points separated by
+# a minus (and optional space); or a single Unicode property specified in the
+# standard Perl form "\p{...}".
#
-# This is no longer used, but retained in case it is needed some day. Put the
-# lines below under __DATA__
+# A blank line or one whose first non-blank character is '#' is a comment.
+# The definition of the macro is terminated by a line unlike those described.
+#
+# Valid types:
+# low generate a macro whose name is 'is_BASE_low' and defines a
+# class that includes only ASCII-range chars. (BASE is the
+# input macro base name.)
+# latin1 generate a macro whose name is 'is_BASE_latin1' and defines a
+# class that includes only upper-Latin1-range chars. It is not
+# designed to take a UTF-8 input parameter.
+# high generate a macro whose name is 'is_BASE_high' and defines a
+# class that includes all relevant code points that are above
+# the Latin1 range. This is for very specialized uses only.
+# It is designed to take only an input UTF-8 parameter.
+# utf8 generate a macro whose name is 'is_BASE_utf8' and defines a
+# class that includes all relevant characters that aren't ASCII.
+# It is designed to take only an input UTF-8 parameter.
+# LATIN1 generate a macro whose name is 'is_BASE_latin1' and defines a
+# class that includes both ASCII and upper-Latin1-range chars.
+# It is not designed to take a UTF-8 input parameter.
+# UTF8 generate a macro whose name is 'is_BASE_utf8' and defines a
+# class that can include any code point, adding the 'low' ones
+# to what 'utf8' works on. It is designed to take only an input
+# UTF-8 parameter.
+# generic generate a macro whose name is 'is_BASE". It has a 2nd,
+# boolean, parameter which indicates if the first one points to
+# a UTF-8 string or not. Thus it works in all circumstances.
+# cp generate a macro whose name is 'is_BASE_cp' and defines a
+# class that returns true if the UV parameter is a member of the
+# class; false if not.
+# A macro of the given type is generated for each type listed in the input.
+# The default return value is the number of octets read to generate the match.
+# Append "-cp" to the type to have it instead return the matched codepoint.
+# The macro name is changed to 'what_BASE...'. See pod for
+# caveats
+# Appending '-both" instead adds an extra parameter to the end of the argument
+# list, which is a pointer as to where to store the number of
+# bytes matched, while also returning the code point. The macro
+# name is changed to 'what_len_BASE...'. See pod for caveats
+#
+# Valid modifiers:
+# safe The input string is not necessarily valid UTF-8. In
+# particular an extra parameter (always the 2nd) to the macro is
+# required, which points to one beyond the end of the string.
+# The macro will make sure not to read off the end of the
+# string. In the case of non-UTF8, it makes sure that the
+# string has at least one byte in it. The macro name has
+# '_safe' appended to it.
+# fast The input string is valid UTF-8. No bounds checking is done,
+# and the macro can make assumptions that lead to faster
+# execution.
+# only_ascii_platform Skip this definition if this program is being run on
+# a non-ASCII platform.
+# only_ebcdic_platform Skip this definition if this program is being run on
+# a non-EBCDIC platform.
+# No modifier need be specified; fast is assumed for this case. If both
+# 'fast', and 'safe' are specified, two macros will be created for each
+# 'type'.
+#
+# If run on a non-ASCII platform will automatically convert the Unicode input
+# to native. The documentation above is slightly wrong in this case. 'low'
+# actually refers to code points whose UTF-8 representation is the same as the
+# non-UTF-8 version (invariants); and 'latin1' refers to all the rest of the
+# code points less than 256.
+
+1; # in the unlikely case we are being used as a module
+
+__DATA__
+# This is no longer used, but retained in case it is needed some day.
# TRICKYFOLD: Problematic fold case letters. When adding to this list, also should add them to regcomp.c and fold_grind.t
# => generic cp generic-cp generic-both :fast safe
# 0x00DF # LATIN SMALL LETTER SHARP S
@@ -694,48 +1108,75 @@ if ( !caller ) {
# 0x1FD3 # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA; maps same as 0390
# 0x1FE3 # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA; maps same as 03B0
-1; # in the unlikely case we are being used as a module
-
-__DATA__
LNBREAK: Line Break: \R
=> generic UTF8 LATIN1 :fast safe
"\x0D\x0A" # CRLF - Network (Windows) line ending
-0x0A # LF | LINE FEED
-0x0B # VT | VERTICAL TAB
-0x0C # FF | FORM FEED
-0x0D # CR | CARRIAGE RETURN
-0x85 # NEL | NEXT LINE
-0x2028 # LINE SEPARATOR
-0x2029 # PARAGRAPH SEPARATOR
+\p{VertSpace}
HORIZWS: Horizontal Whitespace: \h \H
=> generic UTF8 LATIN1 cp :fast safe
-0x09 # HT
-0x20 # SPACE
-0xa0 # NBSP
-0x1680 # OGHAM SPACE MARK
-0x180e # MONGOLIAN VOWEL SEPARATOR
-0x2000 # EN QUAD
-0x2001 # EM QUAD
-0x2002 # EN SPACE
-0x2003 # EM SPACE
-0x2004 # THREE-PER-EM SPACE
-0x2005 # FOUR-PER-EM SPACE
-0x2006 # SIX-PER-EM SPACE
-0x2007 # FIGURE SPACE
-0x2008 # PUNCTUATION SPACE
-0x2009 # THIN SPACE
-0x200A # HAIR SPACE
-0x202f # NARROW NO-BREAK SPACE
-0x205f # MEDIUM MATHEMATICAL SPACE
-0x3000 # IDEOGRAPHIC SPACE
+\p{HorizSpace}
VERTWS: Vertical Whitespace: \v \V
=> generic UTF8 LATIN1 cp :fast safe
-0x0A # LF
-0x0B # VT
-0x0C # FF
-0x0D # CR
-0x85 # NEL
-0x2028 # LINE SEPARATOR
-0x2029 # PARAGRAPH SEPARATOR
+\p{VertSpace}
+
+REPLACEMENT: Unicode REPLACEMENT CHARACTER
+=> UTF8 :safe
+0xFFFD
+
+NONCHAR: Non character code points
+=> UTF8 :fast
+\p{Nchar}
+
+SURROGATE: Surrogate characters
+=> UTF8 :fast
+\p{Gc=Cs}
+
+GCB_L: Grapheme_Cluster_Break=L
+=> UTF8 :fast
+\p{_X_GCB_L}
+
+GCB_LV_LVT_V: Grapheme_Cluster_Break=(LV or LVT or V)
+=> UTF8 :fast
+\p{_X_LV_LVT_V}
+
+GCB_Prepend: Grapheme_Cluster_Break=Prepend
+=> UTF8 :fast
+\p{_X_GCB_Prepend}
+
+GCB_RI: Grapheme_Cluster_Break=RI
+=> UTF8 :fast
+\p{_X_RI}
+
+GCB_SPECIAL_BEGIN: Grapheme_Cluster_Break=special_begins
+=> UTF8 :fast
+\p{_X_Special_Begin}
+
+GCB_T: Grapheme_Cluster_Break=T
+=> UTF8 :fast
+\p{_X_GCB_T}
+
+GCB_V: Grapheme_Cluster_Break=V
+=> UTF8 :fast
+\p{_X_GCB_V}
+
+# This program was run with this enabled, and the results copied to utf8.h;
+# then this was commented out because it takes so long to figure out these 2
+# million code points. The results would not change unless utf8.h decides it
+# wants a maximum other than 4 bytes, or this program creates better
+# optimizations
+#UTF8_CHAR: Matches utf8 from 1 to 4 bytes
+#=> UTF8 :safe only_ascii_platform
+#0x0 - 0x1FFFFF
+
+# This hasn't been commented out, because we haven't an EBCDIC platform to run
+# it on, and the 3 types of EBCDIC allegedly supported by Perl would have
+# different results
+UTF8_CHAR: Matches utf8 from 1 to 5 bytes
+=> UTF8 :safe only_ebcdic_platform
+0x0 - 0x3FFFFF:
+
+QUOTEMETA: Meta-characters that \Q should quote
+=> high :fast
+\p{_Perl_Quotemeta}
diff --git a/regen/unicode_constants.pl b/regen/unicode_constants.pl
new file mode 100644
index 0000000000..e3d588a599
--- /dev/null
+++ b/regen/unicode_constants.pl
@@ -0,0 +1,146 @@
+use v5.16.0;
+use strict;
+use warnings;
+require 'regen/regen_lib.pl';
+use charnames qw(:loose);
+
+my $out_fh = open_new('unicode_constants.h', '>',
+ {style => '*', by => $0,
+ from => "Unicode data"});
+
+print $out_fh <<END;
+
+#ifndef H_UNICODE_CONSTANTS /* Guard against nested #includes */
+#define H_UNICODE_CONSTANTS 1
+
+/* This file contains #defines for various Unicode code points. The values
+ * the macros expand to are the native Unicode code point, or all or portions
+ * of the UTF-8 encoding for the code point. In the former case, the macro
+ * name has the suffix "_NATIVE"; otherwise, the suffix "_UTF8".
+ *
+ * The macros that have the suffix "_UTF8" may have further suffixes, as
+ * follows:
+ * "_FIRST_BYTE" if the value is just the first byte of the UTF-8
+ * representation; the value will be a numeric constant.
+ * "_TAIL" if instead it represents all but the first byte. This, and
+ * with no additional suffix are both string constants */
+
+END
+
+# The data are at the end of this file. A blank line is output as-is.
+# Otherwise, each line represents one #define, and begins with either a
+# Unicode character name with the blanks in it squeezed out or replaced by
+# underscores; or it may be a hexadecimal Unicode code point. In the latter
+# case, the name will be looked-up to use as the name of the macro. In either
+# case, the macro name will have suffixes as listed above, and all blanks will
+# be replaced by underscores.
+#
+# Each line may optionally have one of the following flags on it, separated by
+# white space from the initial token.
+# string indicates that the output is to be of the string form
+# described in the comments above that are placed in the file.
+# first indicates that the output is to be of the FIRST_BYTE form.
+# tail indicates that the output is of the _TAIL form.
+# native indicates that the output is the code point, converted to the
+# platform's native character set if applicable
+#
+# If the code point has no official name, the desired name may be appended
+# after the flag, which will be ignored if there is an official name.
+#
+# This program is used to make it convenient to create compile time constants
+# of UTF-8, and to generate proper EBCDIC as well as ASCII without manually
+# having to figure things out.
+
+while ( <DATA> ) {
+ if ($_ !~ /\S/) {
+ print $out_fh "\n";
+ next;
+ }
+
+ chomp;
+ unless ($_ =~ m/ ^ ( [^\ ]* ) # Name or code point token
+ (?: [\ ]+ ( [^ ]* ) )? # optional flag
+ (?: [\ ]+ ( .* ) )? # name if unnamed; flag is required
+ /x)
+ {
+ die "Unexpected syntax at line $.: $_\n";
+ }
+
+ my $name_or_cp = $1;
+ my $flag = $2;
+ my $desired_name = $3;
+
+ my $name;
+ my $cp;
+
+ if ($name_or_cp =~ /[^[:xdigit:]]/) {
+
+ # Anything that isn't a hex value must be a name.
+ $name = $name_or_cp;
+ $cp = charnames::vianame($name =~ s/_/ /gr);
+ die "Unknown name '$name' at line $.: $_\n" unless defined $name;
+ }
+ else {
+ $cp = $name_or_cp;
+ $name = charnames::viacode("0$cp") // ""; # viacode requires a leading
+ # zero to be sure that the
+ # argument is hex
+ die "Unknown code point '$cp' at line $.: $_\n" unless defined $cp;
+ }
+
+ $name = $desired_name if $name eq "";
+ $name =~ s/ /_/g; # The macro name can have no blanks in it
+
+ my $str = join "", map { sprintf "\\x%02X", $_ }
+ unpack("U0C*", pack("U", hex $cp));
+
+ my $suffix = '_UTF8';
+ if (! defined $flag || $flag eq 'string') {
+ $str = "\"$str\""; # Will be a string constant
+ } elsif ($flag eq 'tail') {
+ $str =~ s/\\x..//; # Remove the first byte
+ $suffix .= '_TAIL';
+ $str = "\"$str\""; # Will be a string constant
+ }
+ elsif ($flag eq 'first') {
+ $str =~ s/ \\x ( .. ) .* /$1/x; # Get the two nibbles of the 1st byte
+ $suffix .= '_FIRST_BYTE';
+ $str = "0x$str"; # Is a numeric constant
+ }
+ elsif ($flag eq 'native') {
+ die "Are you sure you want to run this on an above-Latin1 code point?" if hex $cp > 0xff;
+ $suffix = '_NATIVE';
+ $str = utf8::unicode_to_native(hex $cp);
+ $str = "0x$cp"; # Is a numeric constant
+ }
+ else {
+ die "Unknown flag at line $.: $_\n";
+ }
+ print $out_fh "#define ${name}$suffix $str /* U+$cp */\n";
+}
+
+print $out_fh "\n#endif /* H_UNICODE_CONSTANTS */\n";
+
+read_only_bottom_close_and_rename($out_fh);
+
+__DATA__
+0300 string
+0301 string
+0308 string
+
+03B9 first
+03B9 tail
+
+03C5 first
+03C5 tail
+
+2010 string
+D800 first FIRST_SURROGATE
+
+007F native
+00DF native
+00E5 native
+00C5 native
+00FF native
+00B5 native
+0085 native
diff --git a/regen/utf8_strings.pl b/regen/utf8_strings.pl
deleted file mode 100644
index d6d4c76208..0000000000
--- a/regen/utf8_strings.pl
+++ /dev/null
@@ -1,108 +0,0 @@
-use v5.16.0;
-use strict;
-use warnings;
-require 'regen/regen_lib.pl';
-use charnames qw(:loose);
-
-my $out_fh = open_new('utf8_strings.h', '>',
- {style => '*', by => $0,
- from => "Unicode data"});
-
-print $out_fh <<END;
-/* This file contains #defines for various Unicode code points. The values
- * for the macros are all or portions of the UTF-8 encoding for the code
- * point. Note that the names all have the suffix "_UTF8".
- *
- * The suffix "_FIRST_BYTE" may be appended to the name if the value is just
- * the first byte of the UTF-8 representation; the value will be a numeric
- * constant.
- *
- * The suffix "_TAIL" is appened if instead it represents all but the first
- * byte. This, and with no suffix are both string constants */
-
-END
-
-# The data are at the end of this file. Each line represents one #define.
-# Each line begins with either a Unicode character name with the blanks in it
-# squeezed out or replaced by underscores; or it may be a hexadecimal code
-# point. In the latter case, the name will be looked-up to use as the name
-# of the macro. In either case, the macro name will have suffixes as
-# listed above, and all blanks will be replaced by underscores.
-#
-# Each line may optionally have one of the following flags on it, separated by
-# white space from the initial token.
-# first indicates that the output is to be of the FIRST_BYTE form
-# described in the comments above that are placed in the file.
-# tail indicates that the output is of the _TAIL form.
-#
-# This program is used to make it convenient to create compile time constants
-# of UTF-8, and to generate proper EBCDIC as well as ASCII without manually
-# having to figure things out.
-
-while ( <DATA> ) {
- chomp;
- unless ($_ =~ m/ ^ ( [^\ ]* ) # Name or code point token
- (?: [\ ]+ ( .* ) )? # optional flag
- /x)
- {
- die "Unexpected syntax at line $.: $_\n";
- }
-
- my $name_or_cp = $1;
- my $flag = $2;
-
- my $name;
- my $cp;
-
- if ($name_or_cp =~ /[^[:xdigit:]]/) {
-
- # Anything that isn't a hex value must be a name.
- $name = $name_or_cp;
- $cp = charnames::vianame($name =~ s/_/ /gr);
- die "Unknown name '$name' at line $.: $_\n" unless defined $name;
- }
- else {
- $cp = $name_or_cp;
- $name = charnames::viacode("0$cp"); # viacode requires a leading zero
- # to be sure that the argument is hex
- die "Unknown code point '$cp' at line $.: $_\n" unless defined $cp;
- }
-
- $name =~ s/ /_/g; # The macro name can have no blanks in it
-
- my $str = join "", map { sprintf "\\x%02X", $_ }
- unpack("U0C*", pack("U", hex $cp));
-
- my $suffix = '_UTF8';
- if (! defined $flag) {
- $str = "\"$str\""; # Will be a string constant
- } elsif ($flag eq 'tail') {
- $str =~ s/\\x..//; # Remove the first byte
- $suffix .= '_TAIL';
- $str = "\"$str\""; # Will be a string constant
- }
- elsif ($flag eq 'first') {
- $str =~ s/ \\x ( .. ) .* /$1/x; # Get the two nibbles of the 1st byte
- $suffix .= '_FIRST_BYTE';
- $str = "0x$str"; # Is a numeric constant
- }
- else {
- die "Unknown flag at line $.: $_\n";
- }
- print $out_fh "#define ${name}$suffix $str /* U+$cp */\n";
-}
-
-read_only_bottom_close_and_rename($out_fh);
-
-__DATA__
-0300
-0301
-0308
-03B9 tail
-03C5 tail
-03B9 first
-03C5 first
-1100
-1160
-11A8
-2010
diff --git a/regexec.c b/regexec.c
index 2dc231495b..b04f22113e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -81,7 +81,7 @@
#endif
#include "inline_invlist.c"
-#include "utf8_strings.h"
+#include "unicode_constants.h"
#define RF_tainted 1 /* tainted information used? e.g. locale */
#define RF_warned 2 /* warned about big count? */
@@ -145,14 +145,7 @@
/* No asserts are done for some of these, in case called on a */ \
/* Unicode version in which they map to nothing */ \
LOAD_UTF8_CHARCLASS(X_regular_begin, HYPHEN_UTF8); \
- LOAD_UTF8_CHARCLASS_NO_CHECK(X_special_begin); \
LOAD_UTF8_CHARCLASS(X_extend, COMBINING_GRAVE_ACCENT_UTF8); \
- LOAD_UTF8_CHARCLASS_NO_CHECK(X_prepend);/* empty in most releases*/ \
- LOAD_UTF8_CHARCLASS(X_L, HANGUL_CHOSEONG_KIYEOK_UTF8); \
- LOAD_UTF8_CHARCLASS(X_LV_LVT_V, HANGUL_JUNGSEONG_FILLER_UTF8); \
- LOAD_UTF8_CHARCLASS_NO_CHECK(X_RI); /* empty in many releases */ \
- LOAD_UTF8_CHARCLASS(X_T, HANGUL_JONGSEONG_KIYEOK_UTF8); \
- LOAD_UTF8_CHARCLASS(X_V, HANGUL_JUNGSEONG_FILLER_UTF8)
#define PLACEHOLDER /* Something for the preprocessor to grab onto */
@@ -4026,7 +4019,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
It turns out that 98.4% of all Unicode code points match
Regular_Begin. Doing it this way eliminates a table match in
- the previouls implementation for almost all Unicode code points.
+ the previous implementation for almost all Unicode code points.
There is a subtlety with Prepend* which showed up in testing.
Note that the Begin, and only the Begin is required in:
@@ -4058,6 +4051,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
locinput += 2;
}
else {
+ STRLEN len;
+
/* In case have to backtrack to beginning, then match '.' */
char *starting = locinput;
@@ -4066,16 +4061,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
LOAD_UTF8_CHARCLASS_GCB();
- /* Match (prepend)*, but don't bother trying if empty (as
- * being set to _undef indicates) */
- if (PL_utf8_X_prepend != &PL_sv_undef) {
- while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_prepend,
- (U8*)locinput, utf8_target))
- {
- previous_prepend = locinput;
- locinput += UTF8SKIP(locinput);
- }
+ /* Match (prepend)* */
+ while (locinput < PL_regeol
+ && (len = is_GCB_Prepend_utf8(locinput)))
+ {
+ previous_prepend = locinput;
+ locinput += len;
}
/* As noted above, if we matched a prepend character, but
@@ -4083,8 +4074,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
* matched, as it is guaranteed to match the begin */
if (previous_prepend
&& (locinput >= PL_regeol
- || ! swash_fetch(PL_utf8_X_regular_begin,
- (U8*)locinput, utf8_target)))
+ || (! swash_fetch(PL_utf8_X_regular_begin,
+ (U8*)locinput, utf8_target)
+ && ! is_GCB_SPECIAL_BEGIN_utf8(locinput)))
+ )
{
locinput = previous_prepend;
}
@@ -4098,9 +4091,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
(U8*)locinput, utf8_target)) {
locinput += UTF8SKIP(locinput);
}
- else if (! swash_fetch(PL_utf8_X_special_begin,
- (U8*)locinput, utf8_target))
- {
+ else if (! is_GCB_SPECIAL_BEGIN_utf8(locinput)) {
/* Here did not match the required 'Begin' in the
* second term. So just match the very first
@@ -4112,26 +4103,20 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
/* Here is a special begin. It can be composed of
* several individual characters. One possibility is
* RI+ */
- if (swash_fetch(PL_utf8_X_RI,
- (U8*)locinput, utf8_target))
- {
- locinput += UTF8SKIP(locinput);
+ if ((len = is_GCB_RI_utf8(locinput))) {
+ locinput += len;
while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_RI,
- (U8*)locinput, utf8_target))
+ && (len = is_GCB_RI_utf8(locinput)))
{
- locinput += UTF8SKIP(locinput);
+ locinput += len;
}
- } else /* Another possibility is T+ */
- if (swash_fetch(PL_utf8_X_T,
- (U8*)locinput, utf8_target))
- {
- locinput += UTF8SKIP(locinput);
+ } else if ((len = is_GCB_T_utf8(locinput))) {
+ /* Another possibility is T+ */
+ locinput += len;
while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_T,
- (U8*)locinput, utf8_target))
+ && (len = is_GCB_T_utf8(locinput)))
{
- locinput += UTF8SKIP(locinput);
+ locinput += len;
}
} else {
@@ -4142,10 +4127,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
/* Match L* */
while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_L,
- (U8*)locinput, utf8_target))
+ && (len = is_GCB_L_utf8(locinput)))
{
- locinput += UTF8SKIP(locinput);
+ locinput += len;
}
/* Here, have exhausted L*. If the next character
@@ -4155,8 +4139,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
* Are done. */
if (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_LV_LVT_V,
- (U8*)locinput, utf8_target))
+ && is_GCB_LV_LVT_V_utf8(locinput))
{
/* Otherwise keep going. Must be LV, LVT or V.
@@ -4169,22 +4152,18 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
* V* */
locinput += UTF8SKIP(locinput);
while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_V,
- (U8*)locinput,
- utf8_target))
+ && (len = is_GCB_V_utf8(locinput)))
{
- locinput += UTF8SKIP(locinput);
+ locinput += len;
}
}
/* And any of LV, LVT, or V can be followed
- * by T* */
+ * by T* */
while (locinput < PL_regeol
- && swash_fetch(PL_utf8_X_T,
- (U8*)locinput,
- utf8_target))
+ && (len = is_GCB_T_utf8(locinput)))
{
- locinput += UTF8SKIP(locinput);
+ locinput += len;
}
}
}
@@ -7336,6 +7315,74 @@ S_to_byte_substr(pTHX_ register regexp *prog)
} while (i--);
}
+/* These constants are for finding GCB=LV and GCB=LVT. These are for the
+ * pre-composed Hangul syllables, which are all in a contiguous block and
+ * arranged there in such a way so as to facilitate alorithmic determination of
+ * their characteristics. As such, they don't need a swash, but can be
+ * determined by simple arithmetic. Almost all are GCB=LVT, but every 28th one
+ * is a GCB=LV */
+#define SBASE 0xAC00 /* Start of block */
+#define SCount 11172 /* Length of block */
+#define TCount 28
+
+#if 0 /* This routine is not currently used */
+PERL_STATIC_INLINE bool
+S_is_utf8_X_LV(pTHX_ const U8 *p)
+{
+ /* Unlike most other similarly named routines here, this does not create a
+ * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */
+
+ dVAR;
+
+ UV cp = valid_utf8_to_uvchr(p, NULL);
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_LV;
+
+ /* The earliest Unicode releases did not have these precomposed Hangul
+ * syllables. Set to point to undef in that case, so will return false on
+ * every call */
+ if (! PL_utf8_X_LV) { /* Set up if this is the first time called */
+ PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0);
+ if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) {
+ SvREFCNT_dec(PL_utf8_X_LV);
+ PL_utf8_X_LV = &PL_sv_undef;
+ }
+ }
+
+ return (PL_utf8_X_LV != &PL_sv_undef
+ && cp >= SBASE && cp < SBASE + SCount
+ && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */
+}
+#endif
+
+PERL_STATIC_INLINE bool
+S_is_utf8_X_LVT(pTHX_ const U8 *p)
+{
+ /* Unlike most other similarly named routines here, this does not create a
+ * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */
+
+ dVAR;
+
+ UV cp = valid_utf8_to_uvchr(p, NULL);
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
+
+ /* The earliest Unicode releases did not have these precomposed Hangul
+ * syllables. Set to point to undef in that case, so will return false on
+ * every call */
+ if (! PL_utf8_X_LVT) { /* Set up if this is the first time called */
+ PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0);
+ if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) {
+ SvREFCNT_dec(PL_utf8_X_LVT);
+ PL_utf8_X_LVT = &PL_sv_undef;
+ }
+ }
+
+ return (PL_utf8_X_LVT != &PL_sv_undef
+ && cp >= SBASE && cp < SBASE + SCount
+ && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */
+}
+
/*
* Local variables:
* c-indentation-style: bsd
diff --git a/sv.c b/sv.c
index 497417c53a..acb66df472 100644
--- a/sv.c
+++ b/sv.c
@@ -13376,15 +13376,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param);
PL_utf8_X_regular_begin = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param);
PL_utf8_X_extend = sv_dup_inc(proto_perl->Iutf8_X_extend, param);
- PL_utf8_X_prepend = sv_dup_inc(proto_perl->Iutf8_X_prepend, param);
- PL_utf8_X_special_begin = sv_dup_inc(proto_perl->Iutf8_X_special_begin, param);
- PL_utf8_X_L = sv_dup_inc(proto_perl->Iutf8_X_L, param);
- /*not currently used: PL_utf8_X_LV = sv_dup_inc(proto_perl->Iutf8_X_LV, param);*/
PL_utf8_X_LVT = sv_dup_inc(proto_perl->Iutf8_X_LVT, param);
- PL_utf8_X_RI = sv_dup_inc(proto_perl->Iutf8_X_RI, param);
- PL_utf8_X_T = sv_dup_inc(proto_perl->Iutf8_X_T, param);
- PL_utf8_X_V = sv_dup_inc(proto_perl->Iutf8_X_V, param);
- PL_utf8_X_LV_LVT_V = sv_dup_inc(proto_perl->Iutf8_X_LV_LVT_V, param);
PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param);
PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param);
PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower, param);
@@ -13395,7 +13387,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param);
PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param);
- PL_utf8_quotemeta = sv_dup_inc(proto_perl->Iutf8_quotemeta, param);
PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
diff --git a/unicode_constants.h b/unicode_constants.h
new file mode 100644
index 0000000000..f28a7b727c
--- /dev/null
+++ b/unicode_constants.h
@@ -0,0 +1,46 @@
+/* -*- buffer-read-only: t -*-
+ * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ * This file is built by regen/unicode_constants.pl from Unicode data.
+ * Any changes made here will be lost!
+ */
+
+
+#ifndef H_UNICODE_CONSTANTS /* Guard against nested #includes */
+#define H_UNICODE_CONSTANTS 1
+
+/* This file contains #defines for various Unicode code points. The values
+ * the macros expand to are the native Unicode code point, or all or portions
+ * of the UTF-8 encoding for the code point. In the former case, the macro
+ * name has the suffix "_NATIVE"; otherwise, the suffix "_UTF8".
+ *
+ * The macros that have the suffix "_UTF8" may have further suffixes, as
+ * follows:
+ * "_FIRST_BYTE" if the value is just the first byte of the UTF-8
+ * representation; the value will be a numeric constant.
+ * "_TAIL" if instead it represents all but the first byte. This, and
+ * with no additional suffix are both string constants */
+
+#define COMBINING_GRAVE_ACCENT_UTF8 "\xCC\x80" /* U+0300 */
+#define COMBINING_ACUTE_ACCENT_UTF8 "\xCC\x81" /* U+0301 */
+#define COMBINING_DIAERESIS_UTF8 "\xCC\x88" /* U+0308 */
+
+#define GREEK_SMALL_LETTER_IOTA_UTF8_FIRST_BYTE 0xCE /* U+03B9 */
+#define GREEK_SMALL_LETTER_IOTA_UTF8_TAIL "\xB9" /* U+03B9 */
+
+#define GREEK_SMALL_LETTER_UPSILON_UTF8_FIRST_BYTE 0xCF /* U+03C5 */
+#define GREEK_SMALL_LETTER_UPSILON_UTF8_TAIL "\x85" /* U+03C5 */
+
+#define HYPHEN_UTF8 "\xE2\x80\x90" /* U+2010 */
+#define FIRST_SURROGATE_UTF8_FIRST_BYTE 0xED /* U+D800 */
+
+#define DELETE_NATIVE 0x007F /* U+007F */
+#define LATIN_SMALL_LETTER_SHARP_S_NATIVE 0x00DF /* U+00DF */
+#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE 0x00E5 /* U+00E5 */
+#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE 0x00C5 /* U+00C5 */
+#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE 0x00FF /* U+00FF */
+#define MICRO_SIGN_NATIVE 0x00B5 /* U+00B5 */
+#define NEXT_LINE_NATIVE 0x0085 /* U+0085 */
+
+#endif /* H_UNICODE_CONSTANTS */
+
+/* ex: set ro: */
diff --git a/utf8.c b/utf8.c
index 2172d311b4..660002388f 100644
--- a/utf8.c
+++ b/utf8.c
@@ -2229,186 +2229,6 @@ Perl_is_utf8_X_extend(pTHX_ const U8 *p)
return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend");
}
-bool
-Perl_is_utf8_X_prepend(pTHX_ const U8 *p)
-{
- /* If no code points in the Unicode version being worked on match
- * GCB=Prepend, this will set PL_utf8_X_prepend to &PL_sv_undef during its
- * first call. Otherwise, it will set it to a swash created for it.
- * swash_fetch() hence can't be used without checking first if it is valid
- * to do so. */
-
- dVAR;
- bool initialized = cBOOL(PL_utf8_X_prepend);
- bool ret;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND;
-
- if (PL_utf8_X_prepend == &PL_sv_undef) {
- return FALSE;
- }
-
- if ((ret = is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend"))
- || initialized)
- {
- return ret;
- }
-
- /* Here the code point being checked was not a prepend, and we hadn't
- * initialized PL_utf8_X_prepend, so we don't know if it is just this
- * particular input code point that didn't match, or if the table is
- * completely empty. The is_utf8_common() call did the initialization, so
- * we can inspect the swash's inversion list to find out. If there are no
- * elements in its inversion list, it's empty, and nothing will ever match,
- * so set things up so we can skip the check in future calls. */
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_prepend)) == 0) {
- SvREFCNT_dec(PL_utf8_X_prepend);
- PL_utf8_X_prepend = &PL_sv_undef;
- }
-
- return FALSE;
-}
-
-bool
-Perl_is_utf8_X_special_begin(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_SPECIAL_BEGIN;
-
- return is_utf8_common(p, &PL_utf8_X_special_begin, "_X_Special_Begin");
-}
-
-bool
-Perl_is_utf8_X_L(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_L;
-
- return is_utf8_common(p, &PL_utf8_X_L, "_X_GCB_L");
-}
-
-bool
-Perl_is_utf8_X_RI(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_RI;
-
- return is_utf8_common(p, &PL_utf8_X_RI, "_X_RI");
-}
-
-/* These constants are for finding GCB=LV and GCB=LVT. These are for the
- * pre-composed Hangul syllables, which are all in a contiguous block and
- * arranged there in such a way so as to facilitate alorithmic determination of
- * their characteristics. As such, they don't need a swash, but can be
- * determined by simple arithmetic. Almost all are GCB=LVT, but every 28th one
- * is a GCB=LV */
-#define SBASE 0xAC00 /* Start of block */
-#define SCount 11172 /* Length of block */
-#define TCount 28
-
-#if 0 /* This routine is not currently used */
-bool
-Perl_is_utf8_X_LV(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LV;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LV) { /* Set up if this is the first time called */
- PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LV);
- PL_utf8_X_LV = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LV != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */
-}
-#endif
-
-bool
-Perl_is_utf8_X_LVT(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LVT) { /* Set up if this is the first time called */
- PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LVT);
- PL_utf8_X_LVT = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LVT != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */
-}
-
-bool
-Perl_is_utf8_X_T(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_T;
-
- return is_utf8_common(p, &PL_utf8_X_T, "_X_GCB_T");
-}
-
-bool
-Perl_is_utf8_X_V(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_V;
-
- return is_utf8_common(p, &PL_utf8_X_V, "_X_GCB_V");
-}
-
-bool
-Perl_is_utf8_X_LV_LVT_V(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LV_LVT_V;
-
- return is_utf8_common(p, &PL_utf8_X_LV_LVT_V, "_X_LV_LVT_V");
-}
-
-bool
-Perl__is_utf8_quotemeta(pTHX_ const U8 *p)
-{
- /* For exclusive use of pp_quotemeta() */
-
- dVAR;
-
- PERL_ARGS_ASSERT__IS_UTF8_QUOTEMETA;
-
- return is_utf8_common(p, &PL_utf8_quotemeta, "_Perl_Quotemeta");
-}
-
/*
=for apidoc to_utf8_case
diff --git a/utf8.h b/utf8.h
index 11b5acac1b..bf8251a7ce 100644
--- a/utf8.h
+++ b/utf8.h
@@ -93,12 +93,17 @@ EXTCONST unsigned char PL_utf8skip[];
END_EXTERN_C
+#include "regcharclass.h"
+#include "unicode_constants.h"
+
/* Native character to iso-8859-1 */
#define NATIVE_TO_ASCII(ch) (ch)
#define ASCII_TO_NATIVE(ch) (ch)
/* Transform after encoding */
#define NATIVE_TO_UTF(ch) (ch)
+#define NATIVE_TO_I8(ch) NATIVE_TO_UTF(ch) /* a clearer synonym */
#define UTF_TO_NATIVE(ch) (ch)
+#define I8_TO_NATIVE(ch) UTF_TO_NATIVE(ch)
/* Transforms in wide UV chars */
#define UNI_TO_NATIVE(ch) (ch)
#define NATIVE_TO_UNI(ch) (ch)
@@ -160,7 +165,7 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
#define UNI_IS_INVARIANT(c) (((UV)c) < 0x80)
#define UTF8_IS_START(c) (((U8)c) >= 0xc2)
-#define UTF8_IS_CONTINUATION(c) (((U8)c) >= 0x80 && (((U8)c) <= 0xbf))
+#define UTF8_IS_CONTINUATION(c) ((((U8)c) & 0xC0) == 0x80)
#define UTF8_IS_CONTINUED(c) (((U8)c) & 0x80)
/* Masking with 0xfe allows low bit to be 0 or 1; thus this matches 0xc[23] */
@@ -182,7 +187,8 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
* is anded with it, and the result is non-zero, then using the original value
* in UTF8_ACCUMULATE will overflow, shifting bits off the left */
#define UTF_ACCUMULATION_OVERFLOW_MASK \
- (((UV) UTF_CONTINUATION_MASK) << ((sizeof(UV) * CHARBITS) - UTF_ACCUMULATION_SHIFT))
+ (((UV) UTF_CONTINUATION_MASK) << ((sizeof(UV) * CHARBITS) \
+ - UTF_ACCUMULATION_SHIFT))
#ifdef HAS_QUAD
#define UNISKIP(uv) ( (uv) < 0x80 ? 1 : \
@@ -211,7 +217,8 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
#define NATIVE8_TO_UNI(ch) NATIVE_TO_ASCII(ch) /* a clearer synonym */
-#define UTF8_ACCUMULATE(old, new) (((old) << UTF_ACCUMULATION_SHIFT) | (((U8)new) & UTF_CONTINUATION_MASK))
+#define UTF8_ACCUMULATE(old, new) (((old) << UTF_ACCUMULATION_SHIFT) \
+ | (((U8)new) & UTF_CONTINUATION_MASK))
/* Convert a two (not one) byte utf8 character to a unicode code point value.
* Needs just one iteration of accumulate. Should not be used unless it is
@@ -233,8 +240,10 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
* bytes from an ordinal that is known to fit into two bytes; it must be less
* than 0x3FF to work across both encodings. */
/* Nocast allows these to be used in the case label of a switch statement */
-#define UTF8_TWO_BYTE_HI_nocast(c) UTF_TO_NATIVE(((c) >> UTF_ACCUMULATION_SHIFT) | (0xFF & UTF_START_MARK(2)))
-#define UTF8_TWO_BYTE_LO_nocast(c) UTF_TO_NATIVE(((c) & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK)
+#define UTF8_TWO_BYTE_HI_nocast(c) NATIVE_TO_I8(((c) \
+ >> UTF_ACCUMULATION_SHIFT) | (0xFF & UTF_START_MARK(2)))
+#define UTF8_TWO_BYTE_LO_nocast(c) NATIVE_TO_I8(((c) & UTF_CONTINUATION_MASK) \
+ | UTF_CONTINUATION_MARK)
#define UTF8_TWO_BYTE_HI(c) ((U8) (UTF8_TWO_BYTE_HI_nocast(c)))
#define UTF8_TWO_BYTE_LO(c) ((U8) (UTF8_TWO_BYTE_LO_nocast(c)))
@@ -338,35 +347,11 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
* problematic in some contexts. This allows code that needs to check for
* those to to quickly exclude the vast majority of code points it will
* encounter */
-#ifdef EBCDIC
-# define UTF8_FIRST_PROBLEMATIC_CODE_POINT_FIRST_BYTE UTF_TO_NATIVE(0xF1)
-#else
-# define UTF8_FIRST_PROBLEMATIC_CODE_POINT_FIRST_BYTE 0xED
-#endif
+#define UTF8_FIRST_PROBLEMATIC_CODE_POINT_FIRST_BYTE \
+ FIRST_SURROGATE_UTF8_FIRST_BYTE
-/* ASCII EBCDIC I8
- * U+D7FF: \xED\x9F\xBF \xF1\xB5\xBF\xBF last before surrogates
- * U+D800: \xED\xA0\x80 \xF1\xB6\xA0\xA0 1st surrogate
- * U+DFFF: \xED\xBF\xBF \xF1\xB7\xBF\xBF final surrogate
- * U+E000: \xEE\x80\x80 \xF1\xB8\xA0\xA0 next after surrogates
- */
-#ifdef EBCDIC /* Both versions assume well-formed UTF8 */
-# define UTF8_IS_SURROGATE(s) (*(s) == UTF_TO_NATIVE(0xF1) \
- && ((*((s) +1) == UTF_TO_NATIVE(0xB6)) \
- || *((s) + 1) == UTF_TO_NATIVE(0xB7)))
- /* <send> points to one beyond the end of the string that starts at <s> */
-# define UTF8_IS_REPLACEMENT(s, send) (*(s) == UTF_TO_NATIVE(0xEF) \
- && (send - s) >= 4 \
- && *((s) + 1) == UTF_TO_NATIVE(0xBF) \
- && *((s) + 2) == UTF_TO_NATIVE(0xBF) \
- && *((s) + 3) == UTF_TO_NATIVE(0xBD)
-#else
-# define UTF8_IS_SURROGATE(s) (*(s) == 0xED && *((s) + 1) >= 0xA0)
-# define UTF8_IS_REPLACEMENT(s, send) (*(s) == 0xEF \
- && (send - s) >= 3 \
- && *((s) + 1) == 0xBF \
- && *((s) + 2) == 0xBD)
-#endif
+#define UTF8_IS_SURROGATE(s) cBOOL(is_SURROGATE_utf8(s))
+#define UTF8_IS_REPLACEMENT(s, send) cBOOL(is_REPLACEMENT_utf8_safe(s,send))
/* ASCII EBCDIC I8
* U+10FFFF: \xF4\x8F\xBF\xBF \xF9\xA1\xBF\xBF\xBF max legal Unicode
@@ -374,67 +359,19 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
* U+110001: \xF4\x90\x80\x81 \xF9\xA2\xA0\xA0\xA1
*/
#ifdef EBCDIC /* Both versions assume well-formed UTF8 */
-# define UTF8_IS_SUPER(s) (*(s) >= UTF_TO_NATIVE(0xF9) \
- && (*(s) > UTF_TO_NATIVE(0xF9) || (*((s) + 1) >= UTF_TO_NATIVE(0xA2))))
+# define UTF8_IS_SUPER(s) (NATIVE_TO_I8(*(s)) >= 0xF9 \
+ && (NATIVE_TO_I8(*(s)) > 0xF9) || (NATIVE_TO_I8(*((s)) + 1 >= 0xA2)))
#else
# define UTF8_IS_SUPER(s) (*(s) >= 0xF4 \
&& (*(s) > 0xF4 || (*((s) + 1) >= 0x90)))
#endif
-/* ASCII EBCDIC I8
- * U+FDCF: \xEF\xB7\x8F \xF1\xBF\xAE\xAF last before non-char block
- * U+FDD0: \xEF\xB7\x90 \xF1\xBF\xAE\xB0 first non-char in block
- * U+FDEF: \xEF\xB7\xAF \xF1\xBF\xAF\xAF last non-char in block
- * U+FDF0: \xEF\xB7\xB0 \xF1\xBF\xAF\xB0 first after non-char block
- * U+FFFF: \xEF\xBF\xBF \xF1\xBF\xBF\xBF
- * U+1FFFF: \xF0\x9F\xBF\xBF \xF3\xBF\xBF\xBF
- * U+2FFFF: \xF0\xAF\xBF\xBF \xF5\xBF\xBF\xBF
- * U+3FFFF: \xF0\xBF\xBF\xBF \xF7\xBF\xBF\xBF
- * U+4FFFF: \xF1\x8F\xBF\xBF \xF8\xA9\xBF\xBF\xBF
- * U+5FFFF: \xF1\x9F\xBF\xBF \xF8\xAB\xBF\xBF\xBF
- * U+6FFFF: \xF1\xAF\xBF\xBF \xF8\xAD\xBF\xBF\xBF
- * U+7FFFF: \xF1\xBF\xBF\xBF \xF8\xAF\xBF\xBF\xBF
- * U+8FFFF: \xF2\x8F\xBF\xBF \xF8\xB1\xBF\xBF\xBF
- * U+9FFFF: \xF2\x9F\xBF\xBF \xF8\xB3\xBF\xBF\xBF
- * U+AFFFF: \xF2\xAF\xBF\xBF \xF8\xB5\xBF\xBF\xBF
- * U+BFFFF: \xF2\xBF\xBF\xBF \xF8\xB7\xBF\xBF\xBF
- * U+CFFFF: \xF3\x8F\xBF\xBF \xF8\xB9\xBF\xBF\xBF
- * U+DFFFF: \xF3\x9F\xBF\xBF \xF8\xBB\xBF\xBF\xBF
- * U+EFFFF: \xF3\xAF\xBF\xBF \xF8\xBD\xBF\xBF\xBF
- * U+FFFFF: \xF3\xBF\xBF\xBF \xF8\xBF\xBF\xBF\xBF
- * U+10FFFF: \xF4\x8F\xBF\xBF \xF9\xA1\xBF\xBF\xBF
- */
-#define UTF8_IS_NONCHAR_(s) ( \
- *(s) >= UTF8_FIRST_PROBLEMATIC_CODE_POINT_FIRST_BYTE \
- && ! UTF8_IS_SUPER(s) \
- && UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_FIRST_PROBLEMATIC(s) \
-
-#ifdef EBCDIC /* Both versions assume well-formed UTF8 */
-# define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s) \
- ((*(s) == UTF_TO_NATIVE(0xF1) \
- && (*((s) + 1) == UTF_TO_NATIVE(0xBF) \
- && ((*((s) + 2) == UTF_TO_NATIVE(0xAE) \
- && *((s) + 3) >= UTF_TO_NATIVE(0xB0)) \
- || (*((s) + 2) == UTF_TO_NATIVE(0xAF) \
- && *((s) + 3) <= UTF_TO_NATIVE(0xAF))))) \
- || (UTF8SKIP(*(s)) > 3 \
- /* (These were all derived by inspection and experimentation with an */ \
- /* editor) The next line checks the next to final byte in the char */ \
- && *((s) + UTF8SKIP(*(s)) - 2) == UTF_TO_NATIVE(0xBF) \
- && *((s) + UTF8SKIP(*(s)) - 3) == UTF_TO_NATIVE(0xBF) \
- && (NATIVE_TO_UTF(*((s) + UTF8SKIP(*(s)) - 4)) & 0x81) == 0x81 \
- && (NATIVE_TO_UTF(*((s) + UTF8SKIP(*(s)) - 1)) & 0xBE) == 0XBE))
-#else
-# define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s) \
- ((*(s) == 0xEF \
- && ((*((s) + 1) == 0xB7 && (*((s) + 2) >= 0x90 && (*((s) + 2) <= 0xAF)))\
- /* Gets U+FFF[EF] */ \
- || (*((s) + 1) == 0xBF && ((*((s) + 2) & 0xBE) == 0xBE)))) \
- || ((*((s) + 2) == 0xBF \
- && (*((s) + 3) & 0xBE) == 0xBE \
- /* Excludes things like U+10FFE = \xF0\x90\xBF\xBE */ \
- && (*((s) + 1) & 0x8F) == 0x8F)))
-#endif
+/* These are now machine generated, and the 'given' clause is no longer
+ * applicable */
+#define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s) \
+ cBOOL(is_NONCHAR_utf8(s))
+#define UTF8_IS_NONCHAR_(s) \
+ UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s)
#define UNICODE_SURROGATE_FIRST 0xD800
#define UNICODE_SURROGATE_LAST 0xDFFF
@@ -453,10 +390,10 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
#define UNICODE_DISALLOW_NONCHAR 0x0020
#define UNICODE_DISALLOW_SUPER 0x0040
#define UNICODE_DISALLOW_FE_FF 0x0080
-#define UNICODE_WARN_ILLEGAL_INTERCHANGE \
- (UNICODE_WARN_SURROGATE|UNICODE_WARN_NONCHAR|UNICODE_WARN_SUPER)
-#define UNICODE_DISALLOW_ILLEGAL_INTERCHANGE \
- (UNICODE_DISALLOW_SURROGATE|UNICODE_DISALLOW_NONCHAR|UNICODE_DISALLOW_SUPER)
+#define UNICODE_WARN_ILLEGAL_INTERCHANGE \
+ (UNICODE_WARN_SURROGATE|UNICODE_WARN_NONCHAR|UNICODE_WARN_SUPER)
+#define UNICODE_DISALLOW_ILLEGAL_INTERCHANGE \
+ (UNICODE_DISALLOW_SURROGATE|UNICODE_DISALLOW_NONCHAR|UNICODE_DISALLOW_SUPER)
/* For backward source compatibility, as are now the default */
#define UNICODE_ALLOW_SURROGATE 0
@@ -481,6 +418,14 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
# define UTF8_QUAD_MAX UINT64_C(0x1000000000)
#endif
+#define LATIN_SMALL_LETTER_SHARP_S LATIN_SMALL_LETTER_SHARP_S_NATIVE
+#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS \
+ LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE
+#define MICRO_SIGN MICRO_SIGN_NATIVE
+#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE \
+ LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE_NATIVE
+#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE \
+ LATIN_SMALL_LETTER_A_WITH_RING_ABOVE_NATIVE
#define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3
#define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2
#define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3
@@ -497,14 +442,6 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
#define UNI_DISPLAY_QQ (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
#define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
-#ifndef EBCDIC
-# define LATIN_SMALL_LETTER_SHARP_S 0x00DF
-# define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS 0x00FF
-# define MICRO_SIGN 0x00B5
-# define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE 0x00C5
-# define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE 0x00E5
-#endif
-
#define ANYOF_FOLD_SHARP_S(node, input, end) \
(ANYOF_BITMAP_TEST(node, LATIN_SMALL_LETTER_SHARP_S) && \
(ANYOF_NONBITMAP(node)) && \
@@ -514,111 +451,63 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
toLOWER((input)[1]) == 's')
#define SHARP_S_SKIP 2
-#ifndef EBCDIC
/* If you want to exclude surrogates, and beyond legal Unicode, see the blame
* log for earlier versions which gave details for these */
-# define IS_UTF8_CHAR_1(p) \
- ((p)[0] <= 0x7F)
-# define IS_UTF8_CHAR_2(p) \
- ((p)[0] >= 0xC2 && (p)[0] <= 0xDF && \
- (p)[1] >= 0x80 && (p)[1] <= 0xBF)
-# define IS_UTF8_CHAR_3a(p) \
- ((p)[0] == 0xE0 && \
- (p)[1] >= 0xA0 && (p)[1] <= 0xBF && \
- (p)[2] >= 0x80 && (p)[2] <= 0xBF)
-# define IS_UTF8_CHAR_3b(p) \
- ((p)[0] >= 0xE1 && (p)[0] <= 0xEF && \
- (p)[1] >= 0x80 && (p)[1] <= 0xBF && \
- (p)[2] >= 0x80 && (p)[2] <= 0xBF)
-# define IS_UTF8_CHAR_4a(p) \
- ((p)[0] == 0xF0 && \
- (p)[1] >= 0x90 && (p)[1] <= 0xBF && \
- (p)[2] >= 0x80 && (p)[2] <= 0xBF && \
- (p)[3] >= 0x80 && (p)[3] <= 0xBF)
-/* The 0xF7 allows us to go to 0x1fffff (0x200000 would
- * require five bytes). Not doing any further code points
- * since that is not needed (and that would not be strict
- * UTF-8, anyway). The "slow path" in Perl_is_utf8_char()
- * will take care of the "extended UTF-8". */
-# define IS_UTF8_CHAR_4b(p) \
- ((p)[0] >= 0xF1 && (p)[0] <= 0xF7 && \
- (p)[1] >= 0x80 && (p)[1] <= 0xBF && \
- (p)[2] >= 0x80 && (p)[2] <= 0xBF && \
- (p)[3] >= 0x80 && (p)[3] <= 0xBF)
-
-# define IS_UTF8_CHAR_3(p) \
- (IS_UTF8_CHAR_3a(p) || \
- IS_UTF8_CHAR_3b(p))
-# define IS_UTF8_CHAR_4(p) \
- (IS_UTF8_CHAR_4a(p) || \
- IS_UTF8_CHAR_4b(p))
+
+#ifndef EBCDIC
+/* This was generated by regen/regcharclass.pl, and then moved here. The lines
+ * that generated it were then commented out. This was done solely because it
+ * takes on the order of 10 minutes to generate, and is never going to change.
+ * The EBCDIC equivalent hasn't been commented out in regcharclass.pl, so it
+ * should generate and run the correct stuff */
+/*** GENERATED CODE ***/
+#define is_UTF8_CHAR_utf8_safe(s,e) \
+( ((e)-(s) > 3) ? \
+ ( ( ( ((U8*)s)[0] & 0x80 ) == 0x00 ) ? 1 \
+ : ( 0xC2 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xDF ) ? \
+ ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ? 2 : 0 ) \
+ : ( 0xE0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( ((U8*)s)[1] & 0xE0 ) == 0xA0 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\
+ : ( 0xE1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xEF ) ? \
+ ( ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\
+ : ( 0xF0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( 0x90 <= ((U8*)s)[1] && ((U8*)s)[1] <= 0xBF ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : 0 )\
+ : ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF7 ) ? \
+ ( ( ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : 0 )\
+ : 0 ) \
+: ((e)-(s) > 2) ? \
+ ( ( ( ((U8*)s)[0] & 0x80 ) == 0x00 ) ? 1 \
+ : ( 0xC2 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xDF ) ? \
+ ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ? 2 : 0 ) \
+ : ( 0xE0 == ((U8*)s)[0] ) ? \
+ ( ( ( ( ((U8*)s)[1] & 0xE0 ) == 0xA0 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\
+ : ( 0xE1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xEF ) ? \
+ ( ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\
+ : 0 ) \
+: ((e)-(s) > 1) ? \
+ ( ( ( ((U8*)s)[0] & 0x80 ) == 0x00 ) ? 1 \
+ : ( 0xC2 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xDF ) ? \
+ ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ? 2 : 0 ) \
+ : 0 ) \
+: ((e)-(s) > 0) ? \
+ ( ( ((U8*)s)[0] & 0x80 ) == 0x00 ) \
+: 0 )
+#endif
/* IS_UTF8_CHAR(p) is strictly speaking wrong (not UTF-8) because it
* (1) allows UTF-8 encoded UTF-16 surrogates
* (2) it allows code points past U+10FFFF.
* The Perl_is_utf8_char() full "slow" code will handle the Perl
* "extended UTF-8". */
-# define IS_UTF8_CHAR(p, n) \
- ((n) == 1 ? IS_UTF8_CHAR_1(p) : \
- (n) == 2 ? IS_UTF8_CHAR_2(p) : \
- (n) == 3 ? IS_UTF8_CHAR_3(p) : \
- (n) == 4 ? IS_UTF8_CHAR_4(p) : 0)
-
-# define IS_UTF8_CHAR_FAST(n) ((n) <= 4)
-
-#else /* EBCDIC */
-
-/* This is an attempt to port IS_UTF8_CHAR to EBCDIC based on eyeballing.
- * untested. If want to exclude surrogates and above-Unicode, see the
- * definitions for UTF8_IS_SURROGATE and UTF8_IS_SUPER */
-# define IS_UTF8_CHAR_1(p) \
- (NATIVE_TO_ASCII((p)[0]) <= 0x9F)
-# define IS_UTF8_CHAR_2(p) \
- (NATIVE_TO_I8((p)[0]) >= 0xC5 && NATIVE_TO_I8((p)[0]) <= 0xDF && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF)
-# define IS_UTF8_CHAR_3(p) \
- (NATIVE_TO_I8((p)[0]) == 0xE1 && NATIVE_TO_I8((p)[1]) <= 0xEF && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF)
-# define IS_UTF8_CHAR_4a(p) \
- (NATIVE_TO_I8((p)[0]) == 0xF0 && \
- NATIVE_TO_I8((p)[1]) >= 0xB0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
- NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
-# define IS_UTF8_CHAR_4b(p) \
- (NATIVE_TO_I8((p)[0]) >= 0xF1 && NATIVE_TO_I8((p)[0]) <= 0xF7 && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
- NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
-# define IS_UTF8_CHAR_5a(p) \
- (NATIVE_TO_I8((p)[0]) == 0xF8 && \
- NATIVE_TO_I8((p)[1]) >= 0xA8 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
- NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
-# define IS_UTF8_CHAR_5b(p) \
- (NATIVE_TO_I8((p)[0]) >= 0xF9 && NATIVE_TO_I8((p)[1]) <= 0xFB && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
- NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
- NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
-
-# define IS_UTF8_CHAR_4(p) \
- (IS_UTF8_CHAR_4a(p) || \
- IS_UTF8_CHAR_4b(p))
-# define IS_UTF8_CHAR_5(p) \
- (IS_UTF8_CHAR_5a(p) || \
- IS_UTF8_CHAR_5b(p))
-# define IS_UTF8_CHAR(p, n) \
- ((n) == 1 ? IS_UTF8_CHAR_1(p) : \
- (n) == 2 ? IS_UTF8_CHAR_2(p) : \
- (n) == 3 ? IS_UTF8_CHAR_3(p) : \
- (n) == 4 ? IS_UTF8_CHAR_4(p) : \
- (n) == 5 ? IS_UTF8_CHAR_5(p) : 0)
+#define IS_UTF8_CHAR(p, n) (is_UTF8_CHAR_utf8_safe(p, (p) + (n)) == n)
+/* regen/regcharclass.pl generates is_UTF8_CHAR_utf8_safe() macros for up to
+ * these number of bytes. So this has to be coordinated with it */
+#ifdef EBCDIC
# define IS_UTF8_CHAR_FAST(n) ((n) <= 5)
-
-#endif /* IS_UTF8_CHAR() for UTF-8 */
+#else
+# define IS_UTF8_CHAR_FAST(n) ((n) <= 4)
+#endif
/*
* Local variables:
diff --git a/utf8_strings.h b/utf8_strings.h
deleted file mode 100644
index a83d4231db..0000000000
--- a/utf8_strings.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/* -*- buffer-read-only: t -*-
- * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- * This file is built by regen/utf8_strings.pl from Unicode data.
- * Any changes made here will be lost!
- */
-
-/* This file contains #defines for various Unicode code points. The values
- * for the macros are all or portions of the UTF-8 encoding for the code
- * point. Note that the names all have the suffix "_UTF8".
- *
- * The suffix "_FIRST_BYTE" may be appended to the name if the value is just
- * the first byte of the UTF-8 representation; the value will be a numeric
- * constant.
- *
- * The suffix "_TAIL" is appened if instead it represents all but the first
- * byte. This, and with no suffix are both string constants */
-
-#define COMBINING_GRAVE_ACCENT_UTF8 "\xCC\x80" /* U+0300 */
-#define COMBINING_ACUTE_ACCENT_UTF8 "\xCC\x81" /* U+0301 */
-#define COMBINING_DIAERESIS_UTF8 "\xCC\x88" /* U+0308 */
-#define GREEK_SMALL_LETTER_IOTA_UTF8_TAIL "\xB9" /* U+03B9 */
-#define GREEK_SMALL_LETTER_UPSILON_UTF8_TAIL "\x85" /* U+03C5 */
-#define GREEK_SMALL_LETTER_IOTA_UTF8_FIRST_BYTE 0xCE /* U+03B9 */
-#define GREEK_SMALL_LETTER_UPSILON_UTF8_FIRST_BYTE 0xCF /* U+03C5 */
-#define HANGUL_CHOSEONG_KIYEOK_UTF8 "\xE1\x84\x80" /* U+1100 */
-#define HANGUL_JUNGSEONG_FILLER_UTF8 "\xE1\x85\xA0" /* U+1160 */
-#define HANGUL_JONGSEONG_KIYEOK_UTF8 "\xE1\x86\xA8" /* U+11A8 */
-#define HYPHEN_UTF8 "\xE2\x80\x90" /* U+2010 */
-
-/* ex: set ro: */
diff --git a/utfebcdic.h b/utfebcdic.h
index ec7a376550..3eba83da99 100644
--- a/utfebcdic.h
+++ b/utfebcdic.h
@@ -295,12 +295,6 @@ EXTCONST unsigned char PL_a2e[] = { /* ASCII (iso-8859-1) to EBCDIC (IBM-1047) *
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
-#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS 0xDF
-#define LATIN_SMALL_LETTER_SHARP_S 0x59
-#define MICRO_SIGN 0xA0
-#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE 0x0067
-#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE 0x0047
-
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (IBM-1047) to ASCII (iso-8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
@@ -377,12 +371,6 @@ EXTCONST unsigned char PL_a2e[] = { /* ASCII (ISO8859-1) to EBCDIC (POSIX-BC) */
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xC0, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
-#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS 0xDF
-#define LATIN_SMALL_LETTER_SHARP_S 0x59
-#define MICRO_SIGN 0xA0
-#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE 0x0067
-#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE 0x0047
-
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (POSIX-BC) to ASCII (ISO8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x0A, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
@@ -459,13 +447,6 @@ EXTCONST unsigned char PL_a2e[] = { /* ASCII (ISO8859-1) to EBCDIC (IBM-037) */
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, 0xDF
};
-
-#define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS 0xDF
-#define LATIN_SMALL_LETTER_SHARP_S 0x59
-#define MICRO_SIGN 0xA0
-#define LATIN_CAPITAL_LETTER_A_WITH_RING_ABOVE 0x0067
-#define LATIN_SMALL_LETTER_A_WITH_RING_ABOVE 0x0047
-
EXTCONST unsigned char PL_e2a[] = { /* EBCDIC (IBM-037) to ASCII (ISO8859-1) */
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x85, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
diff --git a/x2p/a2py.c b/x2p/a2py.c
index 2f41ca86ec..aa48daa60c 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -17,6 +17,8 @@
#include "../patchlevel.h"
#endif
#include "util.h"
+#include "../unicode_constants.h"
+#define DELETE_CHAR DELETE_NATIVE
const char *filename;
const char *myname;
@@ -289,11 +291,7 @@ yylex(void)
case ':':
tmp = *s++;
XOP(tmp);
-#ifdef EBCDIC
- case 7:
-#else
- case 127:
-#endif
+ case DELETE_CHAR:
s++;
XTERM('}');
case '}':
View Lorry Controller Status