This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Digest-SHA to CPAN version 5.95
[perl5.git] / cpan / Unicode-Collate / Collate.xs
1
2 #define PERL_NO_GET_CONTEXT /* we want efficiency */
3
4 /* I guese no private function needs pTHX_ and aTHX_ */
5
6 #include "EXTERN.h"
7 #include "perl.h"
8 #include "XSUB.h"
9
10 /* This file is prepared by mkheader */
11 #include "ucatbl.h"
12
13 /* At present, char > 0x10ffff are unaffected without complaint, right? */
14 #define VALID_UTF_MAX    (0x10ffff)
15 #define OVER_UTF_MAX(uv) (VALID_UTF_MAX < (uv))
16
17 static const UV max_div_16 = UV_MAX / 16;
18
19 /* Supported Levels */
20 #define MinLevel        (1)
21 #define MaxLevel        (4)
22
23 /* Shifted weight at 4th level */
24 #define Shift4Wt        (0xFFFF)
25
26 #define VCE_Length      (9)
27
28 #define Hangul_SBase  (0xAC00)
29 #define Hangul_SIni   (0xAC00)
30 #define Hangul_SFin   (0xD7A3)
31 #define Hangul_NCount (588)
32 #define Hangul_TCount (28)
33 #define Hangul_LBase  (0x1100)
34 #define Hangul_LIni   (0x1100)
35 #define Hangul_LFin   (0x1159)
36 #define Hangul_LFill  (0x115F)
37 #define Hangul_LEnd   (0x115F) /* Unicode 5.2 */
38 #define Hangul_VBase  (0x1161)
39 #define Hangul_VIni   (0x1160) /* from Vowel Filler */
40 #define Hangul_VFin   (0x11A2)
41 #define Hangul_VEnd   (0x11A7) /* Unicode 5.2 */
42 #define Hangul_TBase  (0x11A7) /* from "no-final" codepoint */
43 #define Hangul_TIni   (0x11A8)
44 #define Hangul_TFin   (0x11F9)
45 #define Hangul_TEnd   (0x11FF) /* Unicode 5.2 */
46 #define HangulL2Ini   (0xA960) /* Unicode 5.2 */
47 #define HangulL2Fin   (0xA97C) /* Unicode 5.2 */
48 #define HangulV2Ini   (0xD7B0) /* Unicode 5.2 */
49 #define HangulV2Fin   (0xD7C6) /* Unicode 5.2 */
50 #define HangulT2Ini   (0xD7CB) /* Unicode 5.2 */
51 #define HangulT2Fin   (0xD7FB) /* Unicode 5.2 */
52
53 #define CJK_UidIni    (0x4E00)
54 #define CJK_UidFin    (0x9FA5)
55 #define CJK_UidF41    (0x9FBB)
56 #define CJK_UidF51    (0x9FC3)
57 #define CJK_UidF52    (0x9FCB)
58 #define CJK_UidF61    (0x9FCC)
59 #define CJK_ExtAIni   (0x3400) /* Unicode 3.0 */
60 #define CJK_ExtAFin   (0x4DB5) /* Unicode 3.0 */
61 #define CJK_ExtBIni  (0x20000) /* Unicode 3.1 */
62 #define CJK_ExtBFin  (0x2A6D6) /* Unicode 3.1 */
63 #define CJK_ExtCIni  (0x2A700) /* Unicode 5.2 */
64 #define CJK_ExtCFin  (0x2B734) /* Unicode 5.2 */
65 #define CJK_ExtDIni  (0x2B740) /* Unicode 6.0 */
66 #define CJK_ExtDFin  (0x2B81D) /* Unicode 6.0 */
67
68 #define CJK_CompIni  (0xFA0E)
69 #define CJK_CompFin  (0xFA29)
70 static STDCHAR UnifiedCompat[] = {
71       1,1,0,1,0,1,1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,0,0,1,1,1
72 }; /* E F 0 1 2 3 4 5 6 7 8 9 A B C D E F 0 1 2 3 4 5 6 7 8 9 */
73
74 #define codeRange(bcode, ecode) ((bcode) <= code && code <= (ecode))
75
76 MODULE = Unicode::Collate       PACKAGE = Unicode::Collate
77
78 PROTOTYPES: DISABLE
79
80 void
81 _fetch_rest ()
82   PREINIT:
83     char ** rest;
84   PPCODE:
85     for (rest = UCA_rest; *rest; ++rest) {
86         XPUSHs(sv_2mortal(newSVpv((char *) *rest, 0)));
87     }
88
89
90 void
91 _fetch_simple (uv)
92     UV uv
93   PREINIT:
94     U8 ***plane, **row;
95     U8* result = NULL;
96   PPCODE:
97     if (!OVER_UTF_MAX(uv)){
98         plane = (U8***)UCA_simple[uv >> 16];
99         if (plane) {
100             row = plane[(uv >> 8) & 0xff];
101             result = row ? row[uv & 0xff] : NULL;
102         }
103     }
104     if (result) {
105         int i;
106         int num = (int)*result;
107         ++result;
108         for (i = 0; i < num; ++i) {
109             XPUSHs(sv_2mortal(newSVpvn((char *) result, VCE_Length)));
110             result += VCE_Length;
111         }
112     } else {
113         XPUSHs(sv_2mortal(newSViv(0)));
114     }
115
116 SV*
117 _ignorable_simple (uv)
118     UV uv
119   ALIAS:
120     _exists_simple = 1
121   PREINIT:
122     U8 ***plane, **row;
123     int num = -1;
124     U8* result = NULL;
125   CODE:
126     if (!OVER_UTF_MAX(uv)){
127         plane = (U8***)UCA_simple[uv >> 16];
128         if (plane) {
129             row = plane[(uv >> 8) & 0xff];
130             result = row ? row[uv & 0xff] : NULL;
131         }
132         if (result)
133             num = (int)*result; /* assuming 0 <= num < 128 */
134     }
135
136     if (ix)
137         RETVAL = boolSV(num >0);
138     else
139         RETVAL = boolSV(num==0);
140   OUTPUT:
141     RETVAL
142
143
144 void
145 _getHexArray (src)
146     SV* src
147   PREINIT:
148     char *s, *e;
149     STRLEN byte;
150     UV value;
151     bool overflowed = FALSE;
152     const char *hexdigit;
153   PPCODE:
154     s = SvPV(src,byte);
155     for (e = s + byte; s < e;) {
156         hexdigit = strchr((char *) PL_hexdigit, *s++);
157         if (! hexdigit)
158             continue;
159         value = (hexdigit - PL_hexdigit) & 0xF;
160         while (*s) {
161             hexdigit = strchr((char *) PL_hexdigit, *s++);
162             if (! hexdigit)
163                 break;
164             if (overflowed)
165                 continue;
166             if (value > max_div_16) {
167                 overflowed = TRUE;
168                 continue;
169             }
170             value = (value << 4) | ((hexdigit - PL_hexdigit) & 0xF);
171         }
172         XPUSHs(sv_2mortal(newSVuv(overflowed ? UV_MAX : value)));
173     }
174
175
176 SV*
177 _isIllegal (sv)
178     SV* sv
179   PREINIT:
180     UV uv;
181   CODE:
182     if (!sv || !SvIOK(sv))
183         XSRETURN_YES;
184     uv = SvUVX(sv);
185     RETVAL = boolSV(
186            0x10FFFF < uv                   /* out of range */
187         || ((uv & 0xFFFE) == 0xFFFE)       /* ??FFF[EF] */
188         || (0xD800 <= uv && uv <= 0xDFFF)  /* unpaired surrogates */
189         || (0xFDD0 <= uv && uv <= 0xFDEF)  /* other non-characters */
190     );
191 OUTPUT:
192     RETVAL
193
194
195 void
196 _decompHangul (code)
197     UV code
198   PREINIT:
199     UV sindex, lindex, vindex, tindex;
200   PPCODE:
201     /* code *must* be in Hangul syllable.
202      * Check it before you enter here. */
203     sindex =  code - Hangul_SBase;
204     lindex =  sindex / Hangul_NCount;
205     vindex = (sindex % Hangul_NCount) / Hangul_TCount;
206     tindex =  sindex % Hangul_TCount;
207
208     XPUSHs(sv_2mortal(newSVuv(lindex + Hangul_LBase)));
209     XPUSHs(sv_2mortal(newSVuv(vindex + Hangul_VBase)));
210     if (tindex)
211         XPUSHs(sv_2mortal(newSVuv(tindex + Hangul_TBase)));
212
213
214 SV*
215 getHST (code, uca_vers = 0)
216     UV code;
217     IV uca_vers;
218   PREINIT:
219     const char * hangtype;
220     STRLEN typelen;
221   CODE:
222     if (codeRange(Hangul_SIni, Hangul_SFin)) {
223         if ((code - Hangul_SBase) % Hangul_TCount) {
224             hangtype = "LVT"; typelen = 3;
225         } else {
226             hangtype = "LV"; typelen = 2;
227         }
228     } else if (uca_vers < 20) {
229         if (codeRange(Hangul_LIni, Hangul_LFin) || code == Hangul_LFill) {
230             hangtype = "L"; typelen = 1;
231         } else if (codeRange(Hangul_VIni, Hangul_VFin)) {
232             hangtype = "V"; typelen = 1;
233         } else if (codeRange(Hangul_TIni, Hangul_TFin)) {
234             hangtype = "T"; typelen = 1;
235         } else {
236             hangtype = ""; typelen = 0;
237         }
238     } else {
239         if        (codeRange(Hangul_LIni, Hangul_LEnd) ||
240                    codeRange(HangulL2Ini, HangulL2Fin)) {
241             hangtype = "L"; typelen = 1;
242         } else if (codeRange(Hangul_VIni, Hangul_VEnd) ||
243                    codeRange(HangulV2Ini, HangulV2Fin)) {
244             hangtype = "V"; typelen = 1;
245         } else if (codeRange(Hangul_TIni, Hangul_TEnd) ||
246                    codeRange(HangulT2Ini, HangulT2Fin)) {
247             hangtype = "T"; typelen = 1;
248         } else {
249             hangtype = ""; typelen = 0;
250         }
251     }
252
253     RETVAL = newSVpvn(hangtype, typelen);
254 OUTPUT:
255     RETVAL
256
257
258 void
259 _derivCE_9 (code)
260     UV code
261   ALIAS:
262     _derivCE_14 = 1
263     _derivCE_18 = 2
264     _derivCE_20 = 3
265     _derivCE_22 = 4
266     _derivCE_24 = 5
267   PREINIT:
268     UV base, aaaa, bbbb;
269     U8 a[VCE_Length + 1] = "\x00\xFF\xFF\x00\x20\x00\x02\xFF\xFF";
270     U8 b[VCE_Length + 1] = "\x00\xFF\xFF\x00\x00\x00\x00\xFF\xFF";
271     bool basic_unified = 0;
272   PPCODE:
273     if (CJK_UidIni <= code) {
274         if (codeRange(CJK_CompIni, CJK_CompFin))
275             basic_unified = (bool)UnifiedCompat[code - CJK_CompIni];
276         else
277             basic_unified = (ix >= 5 ? (code <= CJK_UidF61) :
278                              ix >= 3 ? (code <= CJK_UidF52) :
279                              ix == 2 ? (code <= CJK_UidF51) :
280                              ix == 1 ? (code <= CJK_UidF41) :
281                                        (code <= CJK_UidFin));
282     }
283     base = (basic_unified)
284             ? 0xFB40 : /* CJK */
285            ((codeRange(CJK_ExtAIni, CJK_ExtAFin))
286                 ||
287             (codeRange(CJK_ExtBIni, CJK_ExtBFin))
288                 ||
289             (ix >= 3 && codeRange(CJK_ExtCIni, CJK_ExtCFin))
290                 ||
291             (ix >= 4 && codeRange(CJK_ExtDIni, CJK_ExtDFin)))
292             ? 0xFB80   /* CJK ext. */
293             : 0xFBC0;  /* others */
294     aaaa =  base + (code >> 15);
295     bbbb = (code & 0x7FFF) | 0x8000;
296     a[1] = (U8)(aaaa >> 8);
297     a[2] = (U8)(aaaa & 0xFF);
298     b[1] = (U8)(bbbb >> 8);
299     b[2] = (U8)(bbbb & 0xFF);
300     a[7] = b[7] = (U8)(code >> 8);
301     a[8] = b[8] = (U8)(code & 0xFF);
302     XPUSHs(sv_2mortal(newSVpvn((char *) a, VCE_Length)));
303     XPUSHs(sv_2mortal(newSVpvn((char *) b, VCE_Length)));
304
305
306 void
307 _derivCE_8 (code)
308     UV code
309   PREINIT:
310     UV aaaa, bbbb;
311     U8 a[VCE_Length + 1] = "\x00\xFF\xFF\x00\x02\x00\x01\xFF\xFF";
312     U8 b[VCE_Length + 1] = "\x00\xFF\xFF\x00\x00\x00\x00\xFF\xFF";
313   PPCODE:
314     aaaa =  0xFF80 + (code >> 15);
315     bbbb = (code & 0x7FFF) | 0x8000;
316     a[1] = (U8)(aaaa >> 8);
317     a[2] = (U8)(aaaa & 0xFF);
318     b[1] = (U8)(bbbb >> 8);
319     b[2] = (U8)(bbbb & 0xFF);
320     a[7] = b[7] = (U8)(code >> 8);
321     a[8] = b[8] = (U8)(code & 0xFF);
322     XPUSHs(sv_2mortal(newSVpvn((char *) a, VCE_Length)));
323     XPUSHs(sv_2mortal(newSVpvn((char *) b, VCE_Length)));
324
325
326 void
327 _uideoCE_8 (code)
328     UV code
329   PREINIT:
330     U8 uice[VCE_Length + 1] = "\x00\xFF\xFF\x00\x20\x00\x02\xFF\xFF";
331   PPCODE:
332     uice[1] = uice[7] = (U8)(code >> 8);
333     uice[2] = uice[8] = (U8)(code & 0xFF);
334     XPUSHs(sv_2mortal(newSVpvn((char *) uice, VCE_Length)));
335
336
337 SV*
338 _isUIdeo (code, uca_vers)
339     UV code;
340     IV uca_vers;
341     bool basic_unified = 0;
342   CODE:
343     /* uca_vers = 0 for _uideoCE_8() */
344     if (CJK_UidIni <= code) {
345         if (codeRange(CJK_CompIni, CJK_CompFin))
346             basic_unified = (bool)UnifiedCompat[code - CJK_CompIni];
347         else
348             basic_unified = (uca_vers >= 24 ? (code <= CJK_UidF61) :
349                              uca_vers >= 20 ? (code <= CJK_UidF52) :
350                              uca_vers >= 18 ? (code <= CJK_UidF51) :
351                              uca_vers >= 14 ? (code <= CJK_UidF41) :
352                                               (code <= CJK_UidFin));
353     }
354     RETVAL = boolSV(
355         (basic_unified)
356                 ||
357         (codeRange(CJK_ExtAIni, CJK_ExtAFin))
358                 ||
359         (uca_vers >=  8 && codeRange(CJK_ExtBIni, CJK_ExtBFin))
360                 ||
361         (uca_vers >= 20 && codeRange(CJK_ExtCIni, CJK_ExtCFin))
362                 ||
363         (uca_vers >= 22 && codeRange(CJK_ExtDIni, CJK_ExtDFin))
364     );
365 OUTPUT:
366     RETVAL
367
368
369 SV*
370 mk_SortKey (self, buf)
371     SV* self;
372     SV* buf;
373   PREINIT:
374     SV *dst, **svp;
375     STRLEN dlen, vlen;
376     U8 *d, *p, *e, *v, *s[MaxLevel], *eachlevel[MaxLevel];
377     AV *bufAV;
378     HV *selfHV;
379     UV back_flag;
380     I32 i, buf_len;
381     IV  lv, level, uca_vers;
382     bool upper_lower, kata_hira, v2i, last_is_var;
383   CODE:
384     if (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
385         selfHV = (HV*)SvRV(self);
386     else
387         croak("$self is not a HASHREF.");
388
389     if (SvROK(buf) && SvTYPE(SvRV(buf)) == SVt_PVAV)
390         bufAV = (AV*)SvRV(buf);
391     else
392         croak("XSUB, not an ARRAYREF.");
393
394     buf_len = av_len(bufAV);
395
396     if (buf_len < 0) { /* empty: -1 */
397         dlen = 2 * (MaxLevel - 1);
398         dst = newSV(dlen);
399         (void)SvPOK_only(dst);
400         d = (U8*)SvPVX(dst);
401         while (dlen--)
402             *d++ = '\0';
403     } else {
404         svp = hv_fetch(selfHV, "level", 5, FALSE);
405         level = svp ? SvIV(*svp) : MaxLevel;
406
407         for (lv = 0; lv < level; lv++) {
408             New(0, eachlevel[lv], 2 * (1 + buf_len) + 1, U8);
409             s[lv] = eachlevel[lv];
410         }
411
412         svp = hv_fetch(selfHV, "upper_before_lower", 18, FALSE);
413         upper_lower = svp ? SvTRUE(*svp) : FALSE;
414         svp = hv_fetch(selfHV, "katakana_before_hiragana", 24, FALSE);
415         kata_hira = svp ? SvTRUE(*svp) : FALSE;
416         svp = hv_fetch(selfHV, "UCA_Version", 11, FALSE);
417         uca_vers = SvIV(*svp);
418         svp = hv_fetch(selfHV, "variable", 8, FALSE);
419         v2i = uca_vers >= 9 && svp /* (vers >= 9) and not (non-ignorable) */
420             ? !(SvCUR(*svp) == 13 && memEQ(SvPVX(*svp), "non-ignorable", 13))
421             : FALSE;
422
423         last_is_var = FALSE;
424         for (i = 0; i <= buf_len; i++) {
425             svp = av_fetch(bufAV, i, FALSE);
426
427             if (svp && SvPOK(*svp))
428                 v = (U8*)SvPV(*svp, vlen);
429             else
430                 croak("not a vwt.");
431
432             if (vlen < VCE_Length) /* ignore short VCE (unexpected) */
433                 continue;
434
435             /* "Ignorable (L1, L2) after Variable" since track. v. 9 */
436             if (v2i) {
437                 if (*v)
438                     last_is_var = TRUE;
439                 else if (v[1] || v[2]) /* non zero primary weight */
440                     last_is_var = FALSE;
441                 else if (last_is_var) /* zero primary weight; skipped */
442                     continue;
443             }
444
445             if (v[5] == 0) { /* tert wt < 256 */
446                 if (upper_lower) {
447                     if (0x8 <= v[6] && v[6] <= 0xC) /* lower */
448                         v[6] -= 6;
449                     else if (0x2 <= v[6] && v[6] <= 0x6) /* upper */
450                         v[6] += 6;
451                     else if (v[6] == 0x1C) /* square upper */
452                         v[6]++;
453                     else if (v[6] == 0x1D) /* square lower */
454                         v[6]--;
455                 }
456                 if (kata_hira) {
457                     if (0x0F <= v[6] && v[6] <= 0x13) /* katakana */
458                         v[6] -= 2;
459                     else if (0xD <= v[6] && v[6] <= 0xE) /* hiragana */
460                         v[6] += 5;
461                 }
462             }
463
464             for (lv = 0; lv < level; lv++) {
465                 if (v[2 * lv + 1] || v[2 * lv + 2]) {
466                     *s[lv]++ = v[2 * lv + 1];
467                     *s[lv]++ = v[2 * lv + 2];
468                 }
469             }
470         }
471
472         dlen = 2 * (MaxLevel - 1);
473         for (lv = 0; lv < level; lv++)
474             dlen += s[lv] - eachlevel[lv];
475
476         dst = newSV(dlen);
477         (void)SvPOK_only(dst);
478         d = (U8*)SvPVX(dst);
479
480         svp = hv_fetch(selfHV, "backwardsFlag", 13, FALSE);
481         back_flag = svp ? SvUV(*svp) : (UV)0;
482
483         for (lv = 0; lv < level; lv++) {
484             if (back_flag & (1 << (lv + 1))) {
485                 p = s[lv];
486                 e = eachlevel[lv];
487                 for ( ; e < p; p -= 2) {
488                     *d++ = p[-2];
489                     *d++ = p[-1];
490                 }
491             }
492             else {
493                 p = eachlevel[lv];
494                 e = s[lv];
495                 while (p < e)
496                     *d++ = *p++;
497             }
498             if (lv + 1 < MaxLevel) { /* lv + 1 == real level */
499                 *d++ = '\0';
500                 *d++ = '\0';
501             }
502         }
503
504         for (lv = level; lv < MaxLevel; lv++) {
505             if (lv + 1 < MaxLevel) { /* lv + 1 == real level */
506                 *d++ = '\0';
507                 *d++ = '\0';
508             }
509         }
510
511         for (lv = 0; lv < level; lv++) {
512             Safefree(eachlevel[lv]);
513         }
514     }
515     *d = '\0';
516     SvCUR_set(dst, d - (U8*)SvPVX(dst));
517     RETVAL = dst;
518 OUTPUT:
519     RETVAL
520
521
522 SV*
523 varCE (self, vce)
524     SV* self;
525     SV* vce;
526   PREINIT:
527     SV *dst, *vbl, **svp;
528     HV *selfHV;
529     U8 *a, *v, *d;
530     STRLEN alen, vlen;
531     bool ig_l2;
532     UV totwt;
533   CODE:
534     if (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
535         selfHV = (HV*)SvRV(self);
536     else
537         croak("$self is not a HASHREF.");
538
539     svp = hv_fetch(selfHV, "ignore_level2", 13, FALSE);
540     ig_l2 = svp ? SvTRUE(*svp) : FALSE;
541
542     svp = hv_fetch(selfHV, "variable", 8, FALSE);
543     vbl = svp ? *svp : &PL_sv_no;
544     a = (U8*)SvPV(vbl, alen);
545     v = (U8*)SvPV(vce, vlen);
546
547     dst = newSV(vlen);
548     d = (U8*)SvPVX(dst);
549     (void)SvPOK_only(dst);
550     Copy(v, d, vlen, U8);
551     SvCUR_set(dst, vlen);
552     d[vlen] = '\0';
553
554     /* primary weight == 0 && secondary weight != 0 */
555     if (ig_l2 && !d[1] && !d[2] && (d[3] || d[4])) {
556         d[3] = d[4] = d[5] = d[6] = '\0';
557     }
558
559     /* variable: checked only the first char and the length,
560        trusting checkCollator() and %VariableOK in Perl ... */
561
562     if (vlen >= VCE_Length && *a != 'n') {
563         if (*v) {
564             if (*a == 's') { /* shifted or shift-trimmed */
565                 d[7] = d[1]; /* wt level 1 to 4 */
566                 d[8] = d[2];
567             } /* else blanked */
568             d[1] = d[2] = d[3] = d[4] = d[5] = d[6] = '\0';
569         } else if (*a == 's') { /* shifted or shift-trimmed */
570             totwt = d[1] + d[2] + d[3] + d[4] + d[5] + d[6];
571             if (alen == 7 && totwt != 0) { /* shifted */
572                 if (d[1] == 0 && d[2] == 1) { /* XXX: CollationAuxiliary-6.2.0 */
573                     d[7] = d[1]; /* wt level 1 to 4 */
574                     d[8] = d[2];
575                 } else {
576                     d[7] = (U8)(Shift4Wt >> 8);
577                     d[8] = (U8)(Shift4Wt & 0xFF);
578                 }
579             } else { /* shift-trimmed or completely ignorable */
580                 d[7] = d[8] = '\0';
581             }
582         } /* else blanked */
583     } /* else non-ignorable */
584     RETVAL = dst;
585 OUTPUT:
586     RETVAL
587
588
589
590 SV*
591 visualizeSortKey (self, key)
592     SV * self
593     SV * key
594   PREINIT:
595     HV *selfHV;
596     SV **svp, *dst;
597     U8 *s, *e, *d;
598     STRLEN klen, dlen;
599     UV uv;
600     IV uca_vers, sep = 0;
601     static const char *upperhex = "0123456789ABCDEF";
602   CODE:
603     if (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
604         selfHV = (HV*)SvRV(self);
605     else
606         croak("$self is not a HASHREF.");
607
608     svp = hv_fetch(selfHV, "UCA_Version", 11, FALSE);
609     if (!svp)
610         croak("Panic: no $self->{UCA_Version} in visualizeSortKey");
611     uca_vers = SvIV(*svp);
612
613     s = (U8*)SvPV(key, klen);
614
615    /* slightly *longer* than the need, but I'm afraid of miscounting;
616       = (klen / 2) * 5 - 1
617              # FFFF and ' ' for each 16bit units but ' ' is less by 1;
618              # ' ' and '|' for level boundaries including the identical level
619        + 2   # '[' and ']'
620        + 1   # '\0'
621        (a) if klen is odd (not expected), maybe more 5 bytes.
622        (b) there is not always the identical level.
623    */
624     dlen = (klen / 2) * 5 + MaxLevel * 2 + 2;
625     dst = newSV(dlen);
626     (void)SvPOK_only(dst);
627     d = (U8*)SvPVX(dst);
628
629     *d++ = '[';
630     for (e = s + klen; s < e; s += 2) {
631         uv = (U16)(*s << 8 | s[1]);
632         if (uv || sep >= MaxLevel) {
633             if ((d[-1] != '[') && ((9 <= uca_vers) || (d[-1] != '|')))
634                 *d++ = ' ';
635             *d++ = upperhex[ (s[0] >> 4) & 0xF ];
636             *d++ = upperhex[  s[0]       & 0xF ];
637             *d++ = upperhex[ (s[1] >> 4) & 0xF ];
638             *d++ = upperhex[  s[1]       & 0xF ];
639         } else {
640             if ((9 <= uca_vers) && (d[-1] != '['))
641                 *d++ = ' ';
642             *d++ = '|';
643             ++sep;
644         }
645     }
646     *d++ = ']';
647     *d   = '\0';
648     SvCUR_set(dst, d - (U8*)SvPVX(dst));
649     RETVAL = dst;
650 OUTPUT:
651     RETVAL