Re: XS-assisted SWASHGET (esp. for t/uni/class.t speedup)

Date: Fri, 25 Nov 2005 00:19:35 +0900
Message-Id: <20051125001031.24E3.BQW10602@nifty.com>

Date: Fri, 25 Nov 2005 01:18:17 +0900
Message-Id: <20051125011410.24E9.BQW10602@nifty.com>

p4raw-id: //depot/perl@26203

diff --git a/universal.c b/universal.c
index 4d44aa7..b3a742b 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -989,7 +989,7 @@ XS(XS_utf8_SWASHGET_heavy)
        bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
        nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
        extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
-       typestr = SvPV_nolen(*typesvp);
+       typestr = (U8*)SvPV_nolen(*typesvp);
        typeto  = typestr[0] == 'T' && typestr[1] == 'o';
        bits    = (U32)SvUV(*bitssvp);
        none    = (U32)SvUV(*nonesvp);
@@ -1048,7 +1048,7 @@ XS(XS_utf8_SWASHGET_heavy)
            nextline = (U8*)memchr(l, '\n', lend - l);
 
            numlen = lend - l;
-           min = (U32)grok_hex(l, &numlen, &flags, NULL);
+           min = (U32)grok_hex((char *)l, &numlen, &flags, NULL);
            if (numlen)
                l += numlen;
            else if (nextline) {
@@ -1064,7 +1064,7 @@ XS(XS_utf8_SWASHGET_heavy)
                ++l;
                flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
                numlen = lend - l;
-               max = (U32)grok_hex(l, &numlen, &flags, NULL);
+               max = (U32)grok_hex((char *)l, &numlen, &flags, NULL);
                if (numlen)
                    l += numlen;
                else
@@ -1076,7 +1076,7 @@ XS(XS_utf8_SWASHGET_heavy)
                        flags = PERL_SCAN_SILENT_ILLDIGIT |
                                PERL_SCAN_DISALLOW_PREFIX;
                        numlen = lend - l;
-                       val = (U32)grok_hex(l, &numlen, &flags, NULL);
+                       val = (U32)grok_hex((char *)l, &numlen, &flags, NULL);
                        if (numlen)
                            l += numlen;
                        else
@@ -1219,7 +1219,7 @@ XS(XS_utf8_SWASHGET_heavy)
                HV* otherhv;
                SV **otherbitssvp;
 
-               othersvp = hv_fetch(hv, namestr, namelen, FALSE);
+               othersvp = hv_fetch(hv, (char *)namestr, namelen, FALSE);
                if (*othersvp && SvROK(*othersvp) &&
                                 SvTYPE(SvRV(*othersvp))==SVt_PVHV)
                    otherhv = (HV*)SvRV(*othersvp);
@@ -1250,7 +1250,7 @@ XS(XS_utf8_SWASHGET_heavy)
 
                    if (!olen)
                        Perl_croak(aTHX_ "SWASHGET didn't return valid swatch");
-                   s = SvPV(swatch, slen);
+                   s = (U8*)SvPV(swatch, slen);
                    if (bits == 1 && otherbits == 1) {
                        if (slen != olen)
                            Perl_croak(aTHX_ "SWASHGET length mismatch");

diff --git a/utf8.c b/utf8.c
index 586fc74..690e4c2 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1364,7 +1364,7 @@ of the result.
 The "swashp" is a pointer to the swash to use.
 
 Both the special and normal mappings are stored lib/unicore/To/Foo.pl,
-and loaded by SWASHGET, using lib/utf8_heavy.pl.  The special (usually,
+and loaded by SWASHNEW, using lib/utf8_heavy.pl.  The special (usually,
 but not always, a multicharacter mapping), is tried first.
 
 The "special" is a string like "utf8::ToSpecLower", which means the
@@ -1696,8 +1696,8 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
            SV *errsv_save;
            ENTER;
            SAVETMPS;
-       /*  save_re_context();  */
-       /*  PUSHSTACKi(PERLSI_MAGIC);  */
+       /*  save_re_context(); */ /* Now SWASHGET doesn't use regex */
+           PUSHSTACKi(PERLSI_MAGIC);
            PUSHMARK(SP);
            EXTEND(SP,3);
            PUSHs((SV*)sv);
@@ -1714,7 +1714,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
            if (!SvTRUE(ERRSV))
                sv_setsv(ERRSV, errsv_save);
            SvREFCNT_dec(errsv_save);
-       /*  POPSTACK; */
+           POPSTACK;
            FREETMPS;
            LEAVE;
            if (IN_PERL_COMPILETIME)