/* Unicode support */
/*
-=for apidoc A|U8*|uvuni_to_utf8|U8 *d|UV uv
+=for apidoc A|U8 *|uvuni_to_utf8|U8 *d|UV uv
Adds the UTF8 representation of the Unicode codepoint C<uv> to the end
of the string C<d>; C<d> should be have at least C<UTF8_MAXLEN+1> free
The actual number of bytes in the UTF-8 character will be returned if
it is valid, otherwise 0.
-=cut */
+=cut
+*/
STRLEN
Perl_is_utf8_char(pTHX_ U8 *s)
{
slen = len - 1;
s++;
- /* The initial value is dubious */
+ u &= UTF_START_MASK(len);
uv = u;
ouv = uv;
while (slen--) {
if (!UTF8_IS_CONTINUATION(*s))
return 0;
uv = UTF8_ACCUMULATE(uv, *s);
- if (uv < ouv)
+ if (uv < ouv)
return 0;
ouv = uv;
s++;
Most code should use utf8_to_uvchr() rather than call this directly.
-=cut */
+=cut
+*/
UV
-Perl_utf8n_to_uvuni(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
+Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
{
UV uv = *s, ouv;
STRLEN len = 1;
}
/*
-=for apidoc A|U8* s|utf8_to_uvchr|STRLEN *retlen
+=for apidoc A|UV|utf8_to_uvchr|U8 *s|STRLEN *retlen
Returns the native character value of the first character in the string C<s>
which is assumed to be in UTF8 encoding; C<retlen> will be set to the
*/
UV
-Perl_utf8_to_uvchr(pTHX_ U8* s, STRLEN* retlen)
+Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
{
return Perl_utf8n_to_uvchr(aTHX_ s, UTF8_MAXLEN, retlen, 0);
}
/*
-=for apidoc A|U8* s|utf8_to_uvuni|STRLEN *retlen
+=for apidoc A|UV|utf8_to_uvuni|U8 *s|STRLEN *retlen
Returns the Unicode code point of the first character in the string C<s>
which is assumed to be in UTF8 encoding; C<retlen> will be set to the
*/
UV
-Perl_utf8_to_uvuni(pTHX_ U8* s, STRLEN* retlen)
+Perl_utf8_to_uvuni(pTHX_ U8 *s, STRLEN *retlen)
{
/* Call the low level routine asking for checks */
return Perl_utf8n_to_uvuni(aTHX_ s, UTF8_MAXLEN, retlen, 0);
}
/*
-=for apidoc A|STRLEN|utf8_length|U8* s|U8 *e
+=for apidoc A|STRLEN|utf8_length|U8 *s|U8 *e
Return the length of the UTF-8 char encoded string C<s> in characters.
Stops at C<e> (inclusive). If C<e E<lt> s> or if the scan would end
*/
STRLEN
-Perl_utf8_length(pTHX_ U8* s, U8* e)
+Perl_utf8_length(pTHX_ U8 *s, U8 *e)
{
STRLEN len = 0;
WARNING: use only if you *know* that the pointers point inside the
same UTF-8 buffer.
-=cut */
+=cut
+*/
IV
Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
}
/*
-=for apidoc A|U8*|utf8_hop|U8 *s|I32 off
+=for apidoc A|U8 *|utf8_hop|U8 *s|I32 off
Return the UTF-8 pointer C<s> displaced by C<off> characters, either
forward or backward.
the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned
on the first byte of character or just after the last byte of a character.
-=cut */
+=cut
+*/
U8 *
Perl_utf8_hop(pTHX_ U8 *s, I32 off)
*/
U8 *
-Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
+Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
{
U8 *send;
U8 *d;
is unchanged. Do nothing if C<is_utf8> points to 0. Sets C<is_utf8> to
0 if C<s> is converted or contains all 7bit characters.
-=cut */
+=cut
+*/
U8 *
-Perl_bytes_from_utf8(pTHX_ U8* s, STRLEN *len, bool *is_utf8)
+Perl_bytes_from_utf8(pTHX_ U8 *s, STRLEN *len, bool *is_utf8)
{
U8 *d;
U8 *start = s;
*/
U8*
-Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len)
+Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len)
{
U8 *send;
U8 *d;
Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr)
{
HV* hv = (HV*)SvRV(sv);
+ /* Given a UTF-X encoded char 0xAA..0xYY,0xZZ
+ then the "swatch" is a vec() for al the chars which start
+ with 0xAA..0xYY
+ So the key in the hash is length of encoded char -1
+ */
U32 klen = UTF8SKIP(ptr) - 1;
- U32 off = ptr[klen] & 127; /* NB: 64 bit always 0 when len > 1 */
+ U32 off = ptr[klen];
STRLEN slen;
- STRLEN needents = (klen ? 64 : 128);
+ STRLEN needents;
U8 *tmps;
U32 bit;
SV *retval;
+ if (klen == 0)
+ {
+ /* If char in invariant then swatch is for all the invariant chars
+ * In both UTF-8 and UTF8-MOD that happens to be UTF_CONTINUATION_MARK
+ */
+ needents = UTF_CONTINUATION_MARK;
+ off = NATIVE_TO_UTF(ptr[klen]);
+ }
+ else
+ {
+ /* If char is encoded then swatch is for the prefix */
+ needents = (1 << UTF_ACCUMULATION_SHIFT);
+ off = NATIVE_TO_UTF(ptr[klen]) & UTF_CONTINUATION_MASK;
+ }
+
/*
* This single-entry cache saves about 1/3 of the utf8 overhead in test
* suite. (That is, only 7-8% overall over just a hash cache. Still,
PUSHMARK(SP);
EXTEND(SP,3);
PUSHs((SV*)sv);
- PUSHs(sv_2mortal(newSViv(code_point & ~(needents - 1))));
+ /* On EBCDIC & ~(0xA0-1) isn't a useful thing to do */
+ PUSHs(sv_2mortal(newSViv((klen) ? (code_point & ~(needents - 1)) : 0)));
PUSHs(sv_2mortal(newSViv(needents)));
PUTBACK;
if (call_method("SWASHGET", G_SCALAR))
svp = hv_store(hv, (char*)ptr, klen, retval, 0);
- if (!svp || !(tmps = (U8*)SvPV(*svp, slen)) || slen < 8)
+ if (!svp || !(tmps = (U8*)SvPV(*svp, slen)) || (slen << 3) < needents)
Perl_croak(aTHX_ "SWASHGET didn't return result of proper length");
}
/*
-=for apidoc A|U8*|uvchr_to_utf8|U8 *d|UV uv
+=for apidoc A|U8 *|uvchr_to_utf8|U8 *d|UV uv
Adds the UTF8 representation of the Native codepoint C<uv> to the end
of the string C<d>; C<d> should be have at least C<UTF8_MAXLEN+1> free
/*
-=for apidoc A|U8* s|utf8n_to_uvchr|STRLEN curlen, STRLEN *retlen, U32 flags
+=for apidoc A|UV|utf8n_to_uvchr|U8 *s|STRLEN curlen|STRLEN *retlen|U32 flags
Returns the native character value of the first character in the string C<s>
which is assumed to be in UTF8 encoding; C<retlen> will be set to the
*/
#undef Perl_utf8n_to_uvchr
UV
-Perl_utf8n_to_uvchr(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
+Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
{
UV uv = Perl_utf8n_to_uvuni(aTHX_ s, curlen, retlen, flags);
return UNI_TO_NATIVE(uv);
projects / p5sagit/p5-mst-13.2.git / blobdiff