Ok, I'm a moron. When I originally implemented ENABLE_GC_FRIENDLY, I
[platform/upstream/glib.git] / glib / gen-unicode-tables.pl
1 #! /usr/bin/perl -w
2
3 #    Copyright (C) 1998, 1999 Tom Tromey
4
5 #    This program is free software; you can redistribute it and/or modify
6 #    it under the terms of the GNU General Public License as published by
7 #    the Free Software Foundation; either version 2, or (at your option)
8 #    any later version.
9
10 #    This program is distributed in the hope that it will be useful,
11 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
12 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 #    GNU General Public License for more details.
14
15 #    You should have received a copy of the GNU General Public License
16 #    along with this program; if not, write to the Free Software
17 #    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
18 #    02111-1307, USA.
19
20 # gen-unicode-tables.pl - Generate tables for libunicode from Unicode data.
21 # See http://www.unicode.org/Public/UNIDATA/UnicodeCharacterDatabase.html
22 # Usage: gen-unicode-tables.pl [-decomp | -both] UNICODE-VERSION UnicodeData.txt LineBreak.txt
23 # I consider the output of this program to be unrestricted.  Use it as
24 # you will.
25
26 # FIXME:
27 # * We could save even more space in the generated table by using
28 #   indexes and not pointers.
29 # * For decomp table it might make sense to use a shift count other
30 #   than 8.  We could easily compute the perfect shift count.
31
32 use vars qw($CODE $NAME $CATEGORY $COMBINING_CLASSES $BIDI_CATEGORY $DECOMPOSITION $DECIMAL_VALUE $DIGIT_VALUE $NUMERIC_VALUE $MIRRORED $OLD_NAME $COMMENT $UPPER $LOWER $TITLE $BREAK_CODE $BREAK_CATEGORY $BREAK_NAME);
33
34 # Names of fields in Unicode data table.
35 $CODE = 0;
36 $NAME = 1;
37 $CATEGORY = 2;
38 $COMBINING_CLASSES = 3;
39 $BIDI_CATEGORY = 4;
40 $DECOMPOSITION = 5;
41 $DECIMAL_VALUE = 6;
42 $DIGIT_VALUE = 7;
43 $NUMERIC_VALUE = 8;
44 $MIRRORED = 9;
45 $OLD_NAME = 10;
46 $COMMENT = 11;
47 $UPPER = 12;
48 $LOWER = 13;
49 $TITLE = 14;
50
51 # Names of fields in the line break table
52 $BREAK_CODE = 0;
53 $BREAK_PROPERTY = 1;
54 $BREAK_NAME = 2;
55
56 # Map general category code onto symbolic name.
57 %mappings =
58     (
59      # Normative.
60      'Lu' => "G_UNICODE_UPPERCASE_LETTER",
61      'Ll' => "G_UNICODE_LOWERCASE_LETTER",
62      'Lt' => "G_UNICODE_TITLECASE_LETTER",
63      'Mn' => "G_UNICODE_NON_SPACING_MARK",
64      'Mc' => "G_UNICODE_COMBINING_MARK",
65      'Me' => "G_UNICODE_ENCLOSING_MARK",
66      'Nd' => "G_UNICODE_DECIMAL_NUMBER",
67      'Nl' => "G_UNICODE_LETTER_NUMBER",
68      'No' => "G_UNICODE_OTHER_NUMBER",
69      'Zs' => "G_UNICODE_SPACE_SEPARATOR",
70      'Zl' => "G_UNICODE_LINE_SEPARATOR",
71      'Zp' => "G_UNICODE_PARAGRAPH_SEPARATOR",
72      'Cc' => "G_UNICODE_CONTROL",
73      'Cf' => "G_UNICODE_FORMAT",
74      'Cs' => "G_UNICODE_SURROGATE",
75      'Co' => "G_UNICODE_PRIVATE_USE",
76      'Cn' => "G_UNICODE_UNASSIGNED",
77
78      # Informative.
79      'Lm' => "G_UNICODE_MODIFIER_LETTER",
80      'Lo' => "G_UNICODE_OTHER_LETTER",
81      'Pc' => "G_UNICODE_CONNECT_PUNCTUATION",
82      'Pd' => "G_UNICODE_DASH_PUNCTUATION",
83      'Ps' => "G_UNICODE_OPEN_PUNCTUATION",
84      'Pe' => "G_UNICODE_CLOSE_PUNCTUATION",
85      'Pi' => "G_UNICODE_INITIAL_PUNCTUATION",
86      'Pf' => "G_UNICODE_FINAL_PUNCTUATION",
87      'Po' => "G_UNICODE_OTHER_PUNCTUATION",
88      'Sm' => "G_UNICODE_MATH_SYMBOL",
89      'Sc' => "G_UNICODE_CURRENCY_SYMBOL",
90      'Sk' => "G_UNICODE_MODIFIER_SYMBOL",
91      'So' => "G_UNICODE_OTHER_SYMBOL"
92      );
93
94 %break_mappings =
95     (
96      'BK' => "G_UNICODE_BREAK_MANDATORY",
97      'CR' => "G_UNICODE_BREAK_CARRIAGE_RETURN",
98      'LF' => "G_UNICODE_BREAK_LINE_FEED",
99      'CM' => "G_UNICODE_BREAK_COMBINING_MARK",
100      'SG' => "G_UNICODE_BREAK_SURROGATE",
101      'ZW' => "G_UNICODE_BREAK_ZERO_WIDTH_SPACE",
102      'IN' => "G_UNICODE_BREAK_INSEPARABLE",
103      'GL' => "G_UNICODE_BREAK_NON_BREAKING_GLUE",
104      'CB' => "G_UNICODE_BREAK_CONTINGENT",
105      'SP' => "G_UNICODE_BREAK_SPACE",
106      'BA' => "G_UNICODE_BREAK_AFTER",
107      'BB' => "G_UNICODE_BREAK_BEFORE",
108      'B2' => "G_UNICODE_BREAK_BEFORE_AND_AFTER",
109      'HY' => "G_UNICODE_BREAK_HYPHEN",
110      'NS' => "G_UNICODE_BREAK_NON_STARTER",
111      'OP' => "G_UNICODE_BREAK_OPEN_PUNCTUATION",
112      'CL' => "G_UNICODE_BREAK_CLOSE_PUNCTUATION",
113      'QU' => "G_UNICODE_BREAK_QUOTATION",
114      'EX' => "G_UNICODE_BREAK_EXCLAMATION",
115      'ID' => "G_UNICODE_BREAK_IDEOGRAPHIC",
116      'NU' => "G_UNICODE_BREAK_NUMERIC",
117      'IS' => "G_UNICODE_BREAK_INFIX_SEPARATOR",
118      'SY' => "G_UNICODE_BREAK_SYMBOL",
119      'AL' => "G_UNICODE_BREAK_ALPHABETIC",
120      'PR' => "G_UNICODE_BREAK_PREFIX",
121      'PO' => "G_UNICODE_BREAK_POSTFIX",
122      'SA' => "G_UNICODE_BREAK_COMPLEX_CONTEXT",
123      'AI' => "G_UNICODE_BREAK_AMBIGUOUS",
124      'XX' => "G_UNICODE_BREAK_UNKNOWN"
125      );
126
127 # Title case mappings.
128 %title_to_lower = ();
129 %title_to_upper = ();
130
131 $do_decomp = 0;
132 $do_props = 1;
133 if ($ARGV[0] eq '-decomp')
134 {
135     $do_decomp = 1;
136     $do_props = 0;
137     shift @ARGV;
138 }
139 elsif ($ARGV[0] eq '-both')
140 {
141     $do_decomp = 1;
142     shift @ARGV;
143 }
144
145 print "Creating decomp table\n" if ($do_decomp);
146 print "Creating property table\n" if ($do_props);
147
148 print "Unicode data from $ARGV[1]\n";
149
150 open (INPUT, "< $ARGV[1]") || exit 1;
151
152 $last_code = -1;
153 while (<INPUT>)
154 {
155     chop;
156     @fields = split (';', $_, 30);
157     if ($#fields != 14)
158     {
159         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
160     }
161
162     $code = hex ($fields[$CODE]);
163
164     last if ($code > 0xFFFF); # ignore characters out of the basic plane
165
166     if ($code > $last_code + 1)
167     {
168         # Found a gap.
169         if ($fields[$NAME] =~ /Last>/)
170         {
171             # Fill the gap with the last character read,
172             # since this was a range specified in the char database
173             @gfields = @fields;
174         }
175         else
176         {
177             # The gap represents undefined characters.  Only the type
178             # matters.
179             @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
180                         '', '', '', '');
181         }
182         for (++$last_code; $last_code < $code; ++$last_code)
183         {
184             $gfields{$CODE} = sprintf ("%04x", $last_code);
185             &process_one ($last_code, @gfields);
186         }
187     }
188     &process_one ($code, @fields);
189     $last_code = $code;
190 }
191
192 @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
193             '', '', '', '');
194 for (++$last_code; $last_code < 0x10000; ++$last_code)
195 {
196     $gfields{$CODE} = sprintf ("%04x", $last_code);
197     &process_one ($last_code, @gfields);
198 }
199 --$last_code;                   # Want last to be 0xFFFF.
200
201 print "Creating line break table\n";
202
203 print "Line break data from $ARGV[2]\n";
204
205 open (INPUT, "< $ARGV[2]") || exit 1;
206
207 $last_code = -1;
208 while (<INPUT>)
209 {
210     chop;
211
212     next if /^#/;
213
214     @fields = split (';', $_, 30);
215     if ($#fields != 2)
216     {
217         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
218     }
219
220     $code = hex ($fields[$CODE]);
221
222     last if ($code > 0xFFFF); # ignore characters out of the basic plane
223
224     if ($code > $last_code + 1)
225     {
226         # Found a gap.
227         if ($fields[$NAME] =~ /Last>/)
228         {
229             # Fill the gap with the last character read,
230             # since this was a range specified in the char database
231           $gap_break_prop = $fields[$BREAK_PROPERTY];
232           for (++$last_code; $last_code < $code; ++$last_code)
233             {
234               $break_props[$last_code] = $gap_break_prop;
235             }
236         }
237         else
238         {
239           # The gap represents undefined characters. If assigned,
240           # they are AL, if not assigned, XX
241           for (++$last_code; $last_code < $code; ++$last_code)
242             {
243               if ($type[$last_code] eq 'Cn')
244                 {
245                   $break_props[$last_code] = 'XX';
246                 }
247               else
248                 {
249                   $break_props[$last_code] = 'AL';
250                 }
251             }
252         }
253     }
254     $break_props[$code] = $fields[$BREAK_PROPERTY];
255     $last_code = $code;
256 }
257
258 for (++$last_code; $last_code < 0x10000; ++$last_code)
259 {
260   if ($type[$last_code] eq 'Cn')
261     {
262       $break_props[$last_code] = 'XX';
263     }
264   else
265     {
266       $break_props[$last_code] = 'AL';
267     }
268 }
269 --$last_code;                   # Want last to be 0xFFFF.
270
271 print STDERR "Last code is not 0xFFFF" if ($last_code != 0xFFFF);
272
273 &print_tables ($last_code)
274     if $do_props;
275 &print_decomp ($last_code)
276     if $do_decomp;
277
278 &print_line_break ($last_code);
279
280 exit 0;
281
282 # Process a single character.
283 sub process_one
284 {
285     my ($code, @fields) = @_;
286
287     $type[$code] = $fields[$CATEGORY];
288     if ($type[$code] eq 'Nd')
289     {
290         $value[$code] = int ($fields[$DECIMAL_VALUE]);
291     }
292     elsif ($type[$code] eq 'Ll')
293     {
294         $value[$code] = hex ($fields[$UPPER]);
295     }
296     elsif ($type[$code] eq 'Lu')
297     {
298         $value[$code] = hex ($fields[$LOWER]);
299     }
300
301     if ($type[$code] eq 'Lt')
302     {
303         $title_to_lower{$code} = hex ($fields[$LOWER]);
304         $title_to_upper{$code} = hex ($fields[$UPPER]);
305     }
306
307     $cclass[$code] = $fields[$COMBINING_CLASSES];
308
309     # Handle decompositions.
310     if ($fields[$DECOMPOSITION] ne ''
311         && $fields[$DECOMPOSITION] !~ /\<.*\>/)
312     {
313         $decompositions[$code] = $fields[$DECOMPOSITION];
314     }
315 }
316
317 sub print_tables
318 {
319     my ($last) = @_;
320     my ($outfile) = "gunichartables.h";
321
322     local ($bytes_out) = 0;
323
324     print "Writing $outfile...\n";
325
326     open (OUT, "> $outfile");
327
328     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
329     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
330
331     print OUT "#ifndef CHARTABLES_H\n";
332     print OUT "#define CHARTABLES_H\n\n";
333
334     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
335
336     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
337
338     for ($count = 0; $count <= $last; $count += 256)
339     {
340         $row[$count / 256] = &print_row ($count, '(char *) ', 'char', 1,
341                                          'page', \&fetch_type);
342     }
343
344     print OUT "static char *type_table[256] = {\n";
345     for ($count = 0; $count <= $last; $count += 256)
346     {
347         print OUT ",\n" if $count > 0;
348         print OUT "  ", $row[$count / 256];
349         $bytes_out += 4;
350     }
351     print OUT "\n};\n\n";
352
353
354     #
355     # Now print attribute table.
356     #
357
358     for ($count = 0; $count <= $last; $count += 256)
359     {
360         $row[$count / 256] = &print_row ($count, '', 'unsigned short', 2,
361                                          'attrpage', \&fetch_attr);
362     }
363     print OUT "static unsigned short *attr_table[256] = {\n";
364     for ($count = 0; $count <= $last; $count += 256)
365     {
366         print OUT ",\n" if $count > 0;
367         print OUT "  ", $row[$count / 256];
368         $bytes_out += 4;
369     }
370     print OUT "\n};\n\n";
371
372     # FIXME: type.
373     print OUT "static unsigned short title_table[][3] = {\n";
374     my ($item);
375     my ($first) = 1;
376     foreach $item (sort keys %title_to_lower)
377     {
378         print OUT ",\n"
379             unless $first;
380         $first = 0;
381         printf OUT "  { 0x%04x, 0x%04x, 0x%04x }", $item, $title_to_upper{$item}, $title_to_lower{$item};
382         $bytes_out += 6;
383     }
384     print OUT "\n};\n\n";
385
386     print OUT "#endif /* CHARTABLES_H */\n";
387
388     close (OUT);
389
390     printf STDERR "Generated %d bytes in tables\n", $bytes_out;
391 }
392
393 # A fetch function for the type table.
394 sub fetch_type
395 {
396     my ($index) = @_;
397     return $mappings{$type[$index]};
398 }
399
400 # A fetch function for the attribute table.
401 sub fetch_attr
402 {
403     my ($index) = @_;
404     if (defined $value[$index])
405       {
406         return sprintf ("0x%04x", $value[$index]);
407       }
408     else
409       {
410         return "0x0000";
411       }
412 }
413
414 # Print a single "row" of a two-level table.
415 sub print_row
416 {
417     my ($start, $def_pfx, $typname, $typsize, $name, $fetcher) = @_;
418
419     my ($i);
420     my (@values);
421     my ($flag) = 1;
422     my ($off);
423
424     for ($off = 0; $off < 256; ++$off)
425     {
426         $values[$off] = $fetcher->($off + $start);
427         if ($values[$off] ne $values[0])
428         {
429             $flag = 0;
430         }
431     }
432     if ($flag)
433     {
434         return $def_pfx . $values[0];
435     }
436
437     printf OUT "static %s %s%d[256] = {\n  ", $typname, $name, $start / 256;
438     my ($column) = 2;
439     for ($i = $start; $i < $start + 256; ++$i)
440     {
441         print OUT ", "
442             if $i > $start;
443         my ($text) = $values[$i - $start];
444         if (length ($text) + $column + 2 > 78)
445         {
446             print OUT "\n  ";
447             $column = 2;
448         }
449         print OUT $text;
450         $column += length ($text) + 2;
451     }
452     print OUT "\n};\n\n";
453
454     $bytes_out += 256 * $typsize;
455
456     return sprintf "%s%d", $name, $start / 256;
457 }
458
459 # Generate the character decomposition header.
460 sub print_decomp
461 {
462     my ($last) = @_;
463     my ($outfile) = "gunidecomp.h";
464
465     local ($bytes_out) = 0;
466
467     print "Writing $outfile...\n";
468
469     open (OUT, "> $outfile") || exit 1;
470
471     print OUT "/* This file is automatically generated.  DO NOT EDIT! */\n\n";
472     print OUT "#ifndef DECOMP_H\n";
473     print OUT "#define DECOMP_H\n\n";
474
475     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
476
477     my ($count, @row);
478     for ($count = 0; $count <= $last; $count += 256)
479     {
480         $row[$count / 256] = &print_row ($count, '(unsigned char *) ',
481                                          'unsigned char', 1, 'cclass',
482                                          \&fetch_cclass);
483     }
484
485     print OUT "static unsigned char *combining_class_table[256] = {\n";
486     for ($count = 0; $count <= $last; $count += 256)
487     {
488         print OUT ",\n" if $count > 0;
489         print OUT "  ", $row[$count / 256];
490         $bytes_out += 4;
491     }
492     print OUT "\n};\n\n";
493
494     print OUT "typedef struct\n{\n";
495     # FIXME: type.
496     print OUT "  unsigned short ch;\n";
497     print OUT "  unsigned char *expansion;\n";
498     print OUT "} decomposition;\n\n";
499
500     print OUT "static decomposition decomp_table[] =\n{\n";
501     my ($iter);
502     my ($first) = 1;
503     for ($count = 0; $count <= $last; ++$count)
504     {
505         if (defined $decompositions[$count])
506         {
507             print OUT ",\n"
508                 if ! $first;
509             $first = 0;
510             printf OUT "  { 0x%04x, \"", $count;
511             $bytes_out += 2;
512             foreach $iter (&expand_decomp ($count))
513             {
514                 printf OUT "\\x%02x\\x%02x", $iter / 256, $iter & 0xff;
515                 $bytes_out += 2;
516             }
517             # Only a single terminator because one is implied in the string.
518             print OUT "\\0\" }";
519             $bytes_out += 2;
520         }
521     }
522     print OUT "\n};\n\n";
523
524     print OUT "#endif /* DECOMP_H */\n";
525
526     printf STDERR "Generated %d bytes in decomp tables\n", $bytes_out;
527 }
528
529 sub print_line_break
530 {
531     my ($last) = @_;
532     my ($outfile) = "gunibreak.h";
533
534     local ($bytes_out) = 0;
535
536     print "Writing $outfile...\n";
537
538     open (OUT, "> $outfile");
539
540     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
541     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
542
543     print OUT "#ifndef BREAKTABLES_H\n";
544     print OUT "#define BREAKTABLES_H\n\n";
545
546     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
547
548     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
549
550     for ($count = 0; $count <= $last; $count += 256)
551     {
552         $row[$count / 256] = &print_row ($count, '(char *) ', 'char', 1,
553                                          'page',
554                                          \&fetch_break_type);
555     }
556
557     print OUT "static char *break_property_table[256] = {\n";
558     for ($count = 0; $count <= $last; $count += 256)
559     {
560         print OUT ",\n" if $count > 0;
561         print OUT "  ", $row[$count / 256];
562         $bytes_out += 4;
563     }
564     print OUT "\n};\n\n";
565
566     print OUT "#endif /* BREAKTABLES_H */\n";
567
568     close (OUT);
569
570     printf STDERR "Generated %d bytes in break tables\n", $bytes_out;
571 }
572
573
574 # A fetch function for the break properties table.
575 sub fetch_break_type
576 {
577     my ($index) = @_;
578     return $break_mappings{$break_props[$index]};
579 }
580
581 # Fetcher for combining class.
582 sub fetch_cclass
583 {
584     my ($i) = @_;
585     return $cclass[$i];
586 }
587
588 # Expand a character decomposition recursively.
589 sub expand_decomp
590 {
591     my ($code) = @_;
592
593     my ($iter, $val);
594     my (@result) = ();
595     foreach $iter (split (' ', $decompositions[$code]))
596     {
597         $val = hex ($iter);
598         if (defined $decompositions[$val])
599         {
600             push (@result, &expand_decomp ($val));
601         }
602         else
603         {
604             push (@result, $val);
605         }
606     }
607
608     return @result;
609 }