gen-unicode-tables.pl

   1 #! /usr/bin/perl -w
   2
   3 #    Copyright (C) 2003 Simon Josefsson
   4 #    Copyright (C) 1998, 1999 Tom Tromey
   5 #    Copyright (C) 2001 Red Hat Software
   6
   7 #    This program is free software; you can redistribute it and/or modify
   8 #    it under the terms of the GNU General Public License as published by
   9 #    the Free Software Foundation; either version 2, or (at your option)
  10 #    any later version.
  11
  12 #    This program is distributed in the hope that it will be useful,
  13 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #    GNU General Public License for more details.
  16
  17 #    You should have received a copy of the GNU General Public License
  18 #    along with this program; if not, write to the Free Software
  19 #    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  20 #    02111-1307, USA.
  21
  22 # Contributer(s):
  23 #   Andrew Taylor <andrew.taylor@montage.ca>
  24
  25 # gen-unicode-tables.pl - Generate tables for libunicode from Unicode data.
  26 # See http://www.unicode.org/Public/UNIDATA/UnicodeCharacterDatabase.html
  27 # Usage: gen-unicode-tables.pl [-decomp | -both] UNICODE-VERSION UnicodeData.txt LineBreak.txt SpecialCasing.txt CaseFolding.txt
  28 # I consider the output of this program to be unrestricted.  Use it as
  29 # you will.
  30
  31 # FIXME:
  32 # * For decomp table it might make sense to use a shift count other
  33 #   than 8.  We could easily compute the perfect shift count.
  34
  35 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 $CASE_CODE $CASE_LOWER $CASE_TITLE $CASE_UPPER $CASE_CONDITION);
  36
  37 # Names of fields in Unicode data table.
  38 $CODE = 0;
  39 $NAME = 1;
  40 $CATEGORY = 2;
  41 $COMBINING_CLASSES = 3;
  42 $BIDI_CATEGORY = 4;
  43 $DECOMPOSITION = 5;
  44 $DECIMAL_VALUE = 6;
  45 $DIGIT_VALUE = 7;
  46 $NUMERIC_VALUE = 8;
  47 $MIRRORED = 9;
  48 $OLD_NAME = 10;
  49 $COMMENT = 11;
  50 $UPPER = 12;
  51 $LOWER = 13;
  52 $TITLE = 14;
  53
  54 # Names of fields in the line break table
  55 $BREAK_CODE = 0;
  56 $BREAK_PROPERTY = 1;
  57
  58 # Names of fields in the SpecialCasing table
  59 $CASE_CODE = 0;
  60 $CASE_LOWER = 1;
  61 $CASE_TITLE = 2;
  62 $CASE_UPPER = 3;
  63 $CASE_CONDITION = 4;
  64
  65 # Names of fields in the CaseFolding table
  66 $FOLDING_CODE = 0;
  67 $FOLDING_STATUS = 1;
  68 $FOLDING_MAPPING = 2;
  69
  70 # Map general category code onto symbolic name.
  71 %mappings =
  72     (
  73      # Normative.
  74      'Lu' => "G_UNICODE_UPPERCASE_LETTER",
  75      'Ll' => "G_UNICODE_LOWERCASE_LETTER",
  76      'Lt' => "G_UNICODE_TITLECASE_LETTER",
  77      'Mn' => "G_UNICODE_NON_SPACING_MARK",
  78      'Mc' => "G_UNICODE_COMBINING_MARK",
  79      'Me' => "G_UNICODE_ENCLOSING_MARK",
  80      'Nd' => "G_UNICODE_DECIMAL_NUMBER",
  81      'Nl' => "G_UNICODE_LETTER_NUMBER",
  82      'No' => "G_UNICODE_OTHER_NUMBER",
  83      'Zs' => "G_UNICODE_SPACE_SEPARATOR",
  84      'Zl' => "G_UNICODE_LINE_SEPARATOR",
  85      'Zp' => "G_UNICODE_PARAGRAPH_SEPARATOR",
  86      'Cc' => "G_UNICODE_CONTROL",
  87      'Cf' => "G_UNICODE_FORMAT",
  88      'Cs' => "G_UNICODE_SURROGATE",
  89      'Co' => "G_UNICODE_PRIVATE_USE",
  90      'Cn' => "G_UNICODE_UNASSIGNED",
  91
  92      # Informative.
  93      'Lm' => "G_UNICODE_MODIFIER_LETTER",
  94      'Lo' => "G_UNICODE_OTHER_LETTER",
  95      'Pc' => "G_UNICODE_CONNECT_PUNCTUATION",
  96      'Pd' => "G_UNICODE_DASH_PUNCTUATION",
  97      'Ps' => "G_UNICODE_OPEN_PUNCTUATION",
  98      'Pe' => "G_UNICODE_CLOSE_PUNCTUATION",
  99      'Pi' => "G_UNICODE_INITIAL_PUNCTUATION",
 100      'Pf' => "G_UNICODE_FINAL_PUNCTUATION",
 101      'Po' => "G_UNICODE_OTHER_PUNCTUATION",
 102      'Sm' => "G_UNICODE_MATH_SYMBOL",
 103      'Sc' => "G_UNICODE_CURRENCY_SYMBOL",
 104      'Sk' => "G_UNICODE_MODIFIER_SYMBOL",
 105      'So' => "G_UNICODE_OTHER_SYMBOL"
 106      );
 107
 108 %break_mappings =
 109     (
 110      'BK' => "G_UNICODE_BREAK_MANDATORY",
 111      'CR' => "G_UNICODE_BREAK_CARRIAGE_RETURN",
 112      'LF' => "G_UNICODE_BREAK_LINE_FEED",
 113      'CM' => "G_UNICODE_BREAK_COMBINING_MARK",
 114      'SG' => "G_UNICODE_BREAK_SURROGATE",
 115      'ZW' => "G_UNICODE_BREAK_ZERO_WIDTH_SPACE",
 116      'IN' => "G_UNICODE_BREAK_INSEPARABLE",
 117      'GL' => "G_UNICODE_BREAK_NON_BREAKING_GLUE",
 118      'CB' => "G_UNICODE_BREAK_CONTINGENT",
 119      'SP' => "G_UNICODE_BREAK_SPACE",
 120      'BA' => "G_UNICODE_BREAK_AFTER",
 121      'BB' => "G_UNICODE_BREAK_BEFORE",
 122      'B2' => "G_UNICODE_BREAK_BEFORE_AND_AFTER",
 123      'HY' => "G_UNICODE_BREAK_HYPHEN",
 124      'NS' => "G_UNICODE_BREAK_NON_STARTER",
 125      'OP' => "G_UNICODE_BREAK_OPEN_PUNCTUATION",
 126      'CL' => "G_UNICODE_BREAK_CLOSE_PUNCTUATION",
 127      'QU' => "G_UNICODE_BREAK_QUOTATION",
 128      'EX' => "G_UNICODE_BREAK_EXCLAMATION",
 129      'ID' => "G_UNICODE_BREAK_IDEOGRAPHIC",
 130      'NU' => "G_UNICODE_BREAK_NUMERIC",
 131      'IS' => "G_UNICODE_BREAK_INFIX_SEPARATOR",
 132      'SY' => "G_UNICODE_BREAK_SYMBOL",
 133      'AL' => "G_UNICODE_BREAK_ALPHABETIC",
 134      'PR' => "G_UNICODE_BREAK_PREFIX",
 135      'PO' => "G_UNICODE_BREAK_POSTFIX",
 136      'SA' => "G_UNICODE_BREAK_COMPLEX_CONTEXT",
 137      'AI' => "G_UNICODE_BREAK_AMBIGUOUS",
 138      'XX' => "G_UNICODE_BREAK_UNKNOWN"
 139      );
 140
 141 # Title case mappings.
 142 %title_to_lower = ();
 143 %title_to_upper = ();
 144
 145 # Maximum length of special-case strings
 146
 147 my $special_case_len = 0;
 148 my @special_cases;
 149
 150 $do_decomp = 0;
 151 $do_props = 1;
 152 if (@ARGV && $ARGV[0] eq '-decomp')
 153 {
 154     $do_decomp = 1;
 155     $do_props = 0;
 156     shift @ARGV;
 157 }
 158 elsif (@ARGV && $ARGV[0] eq '-both')
 159 {
 160     $do_decomp = 1;
 161     shift @ARGV;
 162 }
 163
 164 if (@ARGV != 6) {
 165     $0 =~ s@.*/@@;
 166     die "Usage: $0 [-decomp | -both] UNICODE-VERSION UnicodeData.txt LineBreak.txt SpecialCasing.txt CaseFolding.txt CompositionExclusions.txt\n";
 167 }
 168
 169 print "Creating decomp table\n" if ($do_decomp);
 170 print "Creating property table\n" if ($do_props);
 171
 172 print "Composition exlusions from $ARGV[5]\n";
 173
 174 open (INPUT, "< $ARGV[5]") || exit 1;
 175
 176 while (<INPUT>) {
 177
 178     chop;
 179
 180     next if /^#/;
 181     next if /^\s*$/;
 182
 183     s/\s*#.*//;
 184
 185     s/^\s*//;
 186     s/\s*$//;
 187
 188     $composition_exclusions{hex($_)} = 1;
 189 }
 190
 191 close INPUT;
 192
 193 print "Unicode data from $ARGV[1]\n";
 194
 195 open (INPUT, "< $ARGV[1]") || exit 1;
 196
 197 $last_code = -1;
 198 while (<INPUT>)
 199 {
 200     chop;
 201     @fields = split (';', $_, 30);
 202     if ($#fields != 14)
 203     {
 204         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
 205     }
 206
 207     $code = hex ($fields[$CODE]);
 208
 209     last if ($code > 0xFFFF); # ignore characters out of the basic plane
 210
 211     if ($code > $last_code + 1)
 212     {
 213         # Found a gap.
 214         if ($fields[$NAME] =~ /Last>/)
 215         {
 216             # Fill the gap with the last character read,
 217             # since this was a range specified in the char database
 218             @gfields = @fields;
 219         }
 220         else
 221         {
 222             # The gap represents undefined characters.  Only the type
 223             # matters.
 224             @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 225                         '', '', '', '');
 226         }
 227         for (++$last_code; $last_code < $code; ++$last_code)
 228         {
 229             $gfields{$CODE} = sprintf ("%04x", $last_code);
 230             &process_one ($last_code, @gfields);
 231         }
 232     }
 233     &process_one ($code, @fields);
 234     $last_code = $code;
 235 }
 236
 237 close INPUT;
 238
 239 @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 240             '', '', '', '');
 241 for (++$last_code; $last_code < 0x10000; ++$last_code)
 242 {
 243     $gfields{$CODE} = sprintf ("%04x", $last_code);
 244     &process_one ($last_code, @gfields);
 245 }
 246 --$last_code;                   # Want last to be 0xFFFF.
 247
 248 print "Creating line break table\n";
 249
 250 print "Line break data from $ARGV[2]\n";
 251
 252 open (INPUT, "< $ARGV[2]") || exit 1;
 253
 254 $last_code = -1;
 255 while (<INPUT>)
 256 {
 257     my ($start_code, $end_code);
 258
 259     chop;
 260
 261     next if /^#/;
 262
 263     s/\s*#.*//;
 264
 265     @fields = split (';', $_, 30);
 266     if ($#fields != 1)
 267     {
 268         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
 269         next;
 270     }
 271
 272     if ($fields[$CODE] =~ /([A-F0-9]{4})..([A-F0-9]{4})/)
 273     {
 274         $start_code = hex ($1);
 275         $end_code = hex ($2);
 276     } else {
 277         $start_code = $end_code = hex ($fields[$CODE]);
 278
 279     }
 280
 281     last if ($start_code > 0xFFFF); # FIXME ignore characters out of the basic plane
 282
 283     if ($start_code > $last_code + 1)
 284     {
 285         # The gap represents undefined characters. If assigned,
 286         # they are AL, if not assigned, XX
 287         for (++$last_code; $last_code < $start_code; ++$last_code)
 288         {
 289             if ($type[$last_code] eq 'Cn')
 290             {
 291                 $break_props[$last_code] = 'XX';
 292             }
 293             else
 294             {
 295                 $break_props[$last_code] = 'AL';
 296             }
 297         }
 298     }
 299
 300     for ($last_code = $start_code; $last_code <= $end_code; $last_code++)
 301     {
 302         $break_props[$last_code] = $fields[$BREAK_PROPERTY];
 303     }
 304
 305     $last_code = $end_code;
 306 }
 307
 308 close INPUT;
 309
 310 for (++$last_code; $last_code < 0x10000; ++$last_code)
 311 {
 312   if ($type[$last_code] eq 'Cn')
 313     {
 314       $break_props[$last_code] = 'XX';
 315     }
 316   else
 317     {
 318       $break_props[$last_code] = 'AL';
 319     }
 320 }
 321 --$last_code;                   # Want last to be 0xFFFF.
 322
 323 print STDERR "Last code is not 0xFFFF" if ($last_code != 0xFFFF);
 324
 325 print "Reading special-casing table for case conversion\n";
 326
 327 open (INPUT, "< $ARGV[3]") || exit 1;
 328
 329 while (<INPUT>)
 330 {
 331     my $code;
 332
 333     chop;
 334
 335     next if /^#/;
 336     next if /^\s*$/;
 337
 338     s/\s*#.*//;
 339
 340     @fields = split ('\s*;\s*', $_, 30);
 341
 342     $raw_code = $fields[$CASE_CODE];
 343     $code = hex ($raw_code);
 344
 345     if ($#fields != 4 && $#fields != 5)
 346     {
 347         printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
 348         next;
 349     }
 350
 351     if (!defined $type[$code])
 352     {
 353         printf STDERR "Special case for code point: $code, which has no defined type\n";
 354         next;
 355     }
 356
 357     if (defined $fields[5]) {
 358         # Ignore conditional special cases - we'll handle them in code
 359         next;
 360     }
 361
 362     if ($type[$code] eq 'Lu')
 363     {
 364         (hex $fields[$CASE_UPPER] == $code) || die "$raw_code is Lu and UCD_Upper($raw_code) != $raw_code";
 365
 366         &add_special_case ($code, $value[$code],$fields[$CASE_LOWER], $fields[$CASE_TITLE]);
 367
 368     } elsif ($type[$code] eq 'Lt')
 369     {
 370         (hex $fields[$CASE_TITLE] == $code) || die "$raw_code is Lt and UCD_Title($raw_code) != $raw_code";
 371
 372         &add_special_case ($code, undef,$fields[$CASE_LOWER], $fields[$CASE_UPPER]);
 373     } elsif ($type[$code] eq 'Ll')
 374     {
 375         (hex $fields[$CASE_LOWER] == $code) || die "$raw_code is Ll and UCD_Lower($raw_code) != $raw_code";
 376
 377         &add_special_case ($code, $value[$code],$fields[$CASE_UPPER], $fields[$CASE_TITLE]);
 378     } else {
 379         printf STDERR "Special case for non-alphabetic code point: $raw_code\n";
 380         next;
 381     }
 382 }
 383
 384 close INPUT;
 385
 386 open (INPUT, "< $ARGV[4]") || exit 1;
 387
 388 my $casefoldlen = 0;
 389 my @casefold;
 390
 391 while (<INPUT>)
 392 {
 393     my $code;
 394
 395     chop;
 396
 397     next if /^#/;
 398     next if /^\s*$/;
 399
 400     s/\s*#.*//;
 401
 402     @fields = split ('\s*;\s*', $_, 30);
 403
 404     $raw_code = $fields[$FOLDING_CODE];
 405     $code = hex ($raw_code);
 406
 407     next if $code > 0xffff;     # FIXME!
 408
 409     if ($#fields != 3)
 410     {
 411         printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
 412         next;
 413     }
 414
 415     next if ($fields[$FOLDING_STATUS] eq 'S');
 416
 417     @values = map { hex ($_) } split /\s+/, $fields[$FOLDING_MAPPING];
 418
 419     # Check simple case
 420
 421     if (@values == 1 &&
 422         !(defined $value[$code] && $value[$code] >= 0xd800 && $value[$code] < 0xdc00) &&
 423         defined $type[$code]) {
 424
 425         my $lower;
 426         if ($type[$code] eq 'Ll')
 427         {
 428             $lower = $code;
 429         } elsif ($type[$code] eq 'Lt')
 430         {
 431             $lower = $title_to_lower{$code};
 432         } elsif ($type[$code] eq 'Lu')
 433         {
 434             $lower = $value[$code];
 435         } else {
 436             $lower = $code;
 437         }
 438
 439         if ($lower == $values[0]) {
 440             next;
 441         }
 442     }
 443
 444     my $string = pack ("U*", @values);
 445     if (1 + length $string > $casefoldlen) {
 446         $casefoldlen = 1 + length $string;
 447     }
 448
 449     push @casefold, [ $code, $string ];
 450 }
 451
 452 close INPUT;
 453
 454 if ($do_props) {
 455     &print_tables ($last_code)
 456 }
 457 if ($do_decomp) {
 458     &print_decomp ($last_code);
 459     &output_composition_table;
 460 }
 461
 462 &print_line_break ($last_code);
 463
 464 exit 0;
 465
 466 # Process a single character.
 467 sub process_one
 468 {
 469     my ($code, @fields) = @_;
 470
 471     $type[$code] = $fields[$CATEGORY];
 472     if ($type[$code] eq 'Nd')
 473     {
 474         $value[$code] = int ($fields[$DECIMAL_VALUE]);
 475     }
 476     elsif ($type[$code] eq 'Ll')
 477     {
 478         $value[$code] = hex ($fields[$UPPER]);
 479     }
 480     elsif ($type[$code] eq 'Lu')
 481     {
 482         $value[$code] = hex ($fields[$LOWER]);
 483     }
 484
 485     if ($type[$code] eq 'Lt')
 486     {
 487         $title_to_lower{$code} = hex ($fields[$LOWER]);
 488         $title_to_upper{$code} = hex ($fields[$UPPER]);
 489     }
 490
 491     $cclass[$code] = $fields[$COMBINING_CLASSES];
 492
 493     # Handle decompositions.
 494     if ($fields[$DECOMPOSITION] ne '')
 495     {
 496         if ($fields[$DECOMPOSITION] =~ s/\<.*\>\s*//) {
 497            $decompose_compat[$code] = 1;
 498         } else {
 499            $decompose_compat[$code] = 0;
 500
 501            if (!exists $composition_exclusions{$code}) {
 502                $compositions{$code} = $fields[$DECOMPOSITION];
 503            }
 504         }
 505         $decompositions[$code] = $fields[$DECOMPOSITION];
 506     }
 507 }
 508
 509 sub print_tables
 510 {
 511     my ($last) = @_;
 512     my ($outfile) = "gunichartables.h";
 513
 514     local ($bytes_out) = 0;
 515
 516     print "Writing $outfile...\n";
 517
 518     open (OUT, "> $outfile");
 519
 520     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
 521     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
 522
 523     print OUT "#ifndef CHARTABLES_H\n";
 524     print OUT "#define CHARTABLES_H\n\n";
 525
 526     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
 527
 528     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 529
 530     printf OUT "#define G_UNICODE_MAX_TABLE_INDEX 1000\n\n";
 531
 532     $table_index = 0;
 533     printf OUT "static const char type_data[][256] = {\n";
 534     for ($count = 0; $count <= $last; $count += 256)
 535     {
 536         $row[$count / 256] = &print_row ($count, 1, \&fetch_type);
 537     }
 538     printf OUT "\n};\n\n";
 539
 540     print OUT "static const short type_table[256] = {\n";
 541     for ($count = 0; $count <= $last; $count += 256)
 542     {
 543         print OUT ",\n" if $count > 0;
 544         print OUT "  ", $row[$count / 256];
 545         $bytes_out += 2;
 546     }
 547     print OUT "\n};\n\n";
 548
 549
 550     #
 551     # Now print attribute table.
 552     #
 553
 554     $table_index = 0;
 555     printf OUT "static const unsigned short attr_data[][256] = {\n";
 556     for ($count = 0; $count <= $last; $count += 256)
 557     {
 558         $row[$count / 256] = &print_row ($count, 2, \&fetch_attr);
 559     }
 560     printf OUT "\n};\n\n";
 561
 562     print OUT "static const short attr_table[256] = {\n";
 563     for ($count = 0; $count <= $last; $count += 256)
 564     {
 565         print OUT ",\n" if $count > 0;
 566         print OUT "  ", $row[$count / 256];
 567         $bytes_out += 2;
 568     }
 569     print OUT "\n};\n\n";
 570
 571     #
 572     # print title case table
 573     #
 574
 575     # FIXME: type.
 576     print OUT "static const unsigned short title_table[][3] = {\n";
 577     my ($item);
 578     my ($first) = 1;
 579     foreach $item (sort keys %title_to_lower)
 580     {
 581         print OUT ",\n"
 582             unless $first;
 583         $first = 0;
 584         printf OUT "  { 0x%04x, 0x%04x, 0x%04x }", $item, $title_to_upper{$item}, $title_to_lower{$item};
 585         $bytes_out += 6;
 586     }
 587     print OUT "\n};\n\n";
 588
 589     #
 590     # And special case conversion table -- conversions that change length
 591     #
 592     &output_special_case_table (\*OUT);
 593     &output_casefold_table (\*OUT);
 594
 595     print OUT "#endif /* CHARTABLES_H */\n";
 596
 597     close (OUT);
 598
 599     printf STDERR "Generated %d bytes in tables\n", $bytes_out;
 600 }
 601
 602 # A fetch function for the type table.
 603 sub fetch_type
 604 {
 605     my ($index) = @_;
 606     return $mappings{$type[$index]};
 607 }
 608
 609 # A fetch function for the attribute table.
 610 sub fetch_attr
 611 {
 612     my ($index) = @_;
 613     if (defined $value[$index])
 614       {
 615         return sprintf ("0x%04x", $value[$index]);
 616       }
 617     else
 618       {
 619         return "0x0000";
 620       }
 621 }
 622
 623 sub print_row
 624 {
 625     my ($start, $typsize, $fetcher) = @_;
 626
 627     my ($i);
 628     my (@values);
 629     my ($flag) = 1;
 630     my ($off);
 631
 632     for ($off = 0; $off < 256; ++$off)
 633     {
 634         $values[$off] = $fetcher->($off + $start);
 635         if ($values[$off] ne $values[0])
 636         {
 637             $flag = 0;
 638         }
 639     }
 640     if ($flag)
 641     {
 642         return $values[0] . " + G_UNICODE_MAX_TABLE_INDEX";
 643     }
 644
 645     printf OUT ",\n" if ($table_index != 0);
 646     printf OUT "  { /* page %d, index %d */\n    ", $start / 256, $table_index;
 647     my ($column) = 4;
 648     for ($i = $start; $i < $start + 256; ++$i)
 649     {
 650         print OUT ", "
 651             if $i > $start;
 652         my ($text) = $values[$i - $start];
 653         if (length ($text) + $column + 2 > 78)
 654         {
 655             print OUT "\n    ";
 656             $column = 4;
 657         }
 658         print OUT $text;
 659         $column += length ($text) + 2;
 660     }
 661     print OUT "\n  }";
 662
 663     $bytes_out += 256 * $typsize;
 664
 665     return sprintf "%d /* page %d */", $table_index++, $start / 256;
 666 }
 667
 668 # Generate the character decomposition header.
 669 sub print_decomp
 670 {
 671     my ($last) = @_;
 672     my ($outfile) = "gunidecomp.h";
 673
 674     local ($bytes_out) = 0;
 675
 676     print "Writing $outfile...\n";
 677
 678     open (OUT, "> $outfile") || exit 1;
 679
 680     print OUT "/* This file is automatically generated.  DO NOT EDIT! */\n\n";
 681     print OUT "#ifndef DECOMP_H\n";
 682     print OUT "#define DECOMP_H\n\n";
 683
 684     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 685
 686     printf OUT "#define G_UNICODE_MAX_TABLE_INDEX 1000\n\n";
 687
 688     my ($count, @row);
 689     $table_index = 0;
 690     printf OUT "static const unsigned char cclass_data[][256] = {\n";
 691     for ($count = 0; $count <= $last; $count += 256)
 692     {
 693         $row[$count / 256] = &print_row ($count, 1, \&fetch_cclass);
 694     }
 695     printf OUT "\n};\n\n";
 696
 697     print OUT "static const short combining_class_table[256] = {\n";
 698     for ($count = 0; $count <= $last; $count += 256)
 699     {
 700         print OUT ",\n" if $count > 0;
 701         print OUT "  ", $row[$count / 256];
 702         $bytes_out += 2;
 703     }
 704     print OUT "\n};\n\n";
 705
 706     print OUT "typedef struct\n{\n";
 707     # FIXME: type.
 708     print OUT "  unsigned short ch;\n";
 709     print OUT "  unsigned char canon_offset;\n";
 710     print OUT "  unsigned char compat_offset;\n";
 711     print OUT "  unsigned short expansion_offset;\n";
 712     print OUT "} decomposition;\n\n";
 713
 714     print OUT "static const decomposition decomp_table[] =\n{\n";
 715     my ($iter);
 716     my ($first) = 1;
 717     my ($decomp_string) = "";
 718     my ($decomp_string_offset) = 0;
 719     for ($count = 0; $count <= $last; ++$count)
 720     {
 721         if (defined $decompositions[$count])
 722         {
 723             print OUT ",\n"
 724                 if ! $first;
 725             $first = 0;
 726
 727             my $canon_decomp;
 728             my $compat_decomp;
 729
 730             if (!$decompose_compat[$count]) {
 731                 $canon_decomp = make_decomp ($count, 0);
 732             }
 733             $compat_decomp = make_decomp ($count, 1);
 734
 735             if (defined $canon_decomp && $compat_decomp eq $canon_decomp) {
 736                 undef $compat_decomp;
 737             }
 738
 739             my $string = "";
 740             my $canon_offset = 0xff;
 741             my $compat_offset = 0xff;
 742
 743             if (defined $canon_decomp) {
 744                 $canon_offset = 0;
 745                 $string .= $canon_decomp;
 746             }
 747             if (defined $compat_decomp) {
 748                 if (defined $canon_decomp) {
 749                     $string .= "\\x00\\x00";
 750                 }
 751                 $compat_offset = (length $string) / 4;
 752                 $string .= $compat_decomp;
 753             }
 754
 755             if (!defined($decomp_offsets{$string})) {
 756                 $decomp_offsets{$string} = $decomp_string_offset;
 757                 $decomp_string .= "\n  \"".$string."\\0\\0\" /* offset ".
 758                     $decomp_string_offset." */";
 759                 $decomp_string_offset += ((length $string) / 4) + 2;
 760
 761                 $bytes_out += (length $string) / 4 + 2; # "\x20"
 762             }
 763
 764             printf OUT qq(  { 0x%04x, %u, %u, %d }),
 765                 $count, $canon_offset, $compat_offset, $decomp_offsets{$string};
 766             $bytes_out += 6;
 767
 768         }
 769     }
 770     print OUT "\n};\n\n";
 771
 772     printf OUT "static const unsigned char decomp_expansion_string[] = %s;\n\n", $decomp_string;
 773
 774     print OUT "#endif /* DECOMP_H */\n";
 775
 776     printf STDERR "Generated %d bytes in decomp tables\n", $bytes_out;
 777 }
 778
 779 sub print_line_break
 780 {
 781     my ($last) = @_;
 782     my ($outfile) = "gunibreak.h";
 783
 784     local ($bytes_out) = 0;
 785
 786     print "Writing $outfile...\n";
 787
 788     open (OUT, "> $outfile");
 789
 790     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
 791     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
 792
 793     print OUT "#ifndef BREAKTABLES_H\n";
 794     print OUT "#define BREAKTABLES_H\n\n";
 795
 796     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
 797
 798     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 799
 800     printf OUT "#define G_UNICODE_MAX_TABLE_INDEX 1000\n\n";
 801
 802     $table_index = 0;
 803     printf OUT "static const char break_property_data[][256] = {\n";
 804     for ($count = 0; $count <= $last; $count += 256)
 805     {
 806         $row[$count / 256] = &print_row ($count, 1, \&fetch_break_type);
 807     }
 808     printf OUT "\n};\n\n";
 809
 810     print OUT "static const short break_property_table[256] = {\n";
 811     for ($count = 0; $count <= $last; $count += 256)
 812     {
 813         print OUT ",\n" if $count > 0;
 814         print OUT "  ", $row[$count / 256];
 815         $bytes_out += 2;
 816     }
 817     print OUT "\n};\n\n";
 818
 819     print OUT "#endif /* BREAKTABLES_H */\n";
 820
 821     close (OUT);
 822
 823     printf STDERR "Generated %d bytes in break tables\n", $bytes_out;
 824 }
 825
 826
 827 # A fetch function for the break properties table.
 828 sub fetch_break_type
 829 {
 830     my ($index) = @_;
 831     return $break_mappings{$break_props[$index]};
 832 }
 833
 834 # Fetcher for combining class.
 835 sub fetch_cclass
 836 {
 837     my ($i) = @_;
 838     return $cclass[$i];
 839 }
 840
 841 # Expand a character decomposition recursively.
 842 sub expand_decomp
 843 {
 844     my ($code, $compat) = @_;
 845
 846     my ($iter, $val);
 847     my (@result) = ();
 848     foreach $iter (split (' ', $decompositions[$code]))
 849     {
 850         $val = hex ($iter);
 851         if (defined $decompositions[$val] &&
 852             ($compat || !$decompose_compat[$val]))
 853         {
 854             push (@result, &expand_decomp ($val, $compat));
 855         }
 856         else
 857         {
 858             push (@result, $val);
 859         }
 860     }
 861
 862     return @result;
 863 }
 864
 865 sub make_decomp
 866 {
 867     my ($code, $compat) = @_;
 868
 869     my $result = "";
 870     foreach $iter (&expand_decomp ($code, $compat))
 871     {
 872         $result .= sprintf "\\x%02x\\x%02x", $iter / 256, $iter & 0xff;
 873     }
 874
 875     $result;
 876 }
 877 # Generate special case data string from two fields
 878 sub add_special_case
 879 {
 880     my ($code, $single, $field1, $field2) = @_;
 881
 882     @values = (defined $single ? $single : (),
 883                (map { hex ($_) } split /\s+/, $field1),
 884                0,
 885                (map { hex ($_) } split /\s+/, $field2));
 886     $result = "";
 887
 888
 889     for $value (@values) {
 890         $result .= sprintf ("\\x%02x\\x%02x", $value / 256, $value & 0xff);
 891     }
 892
 893     $result .= "\\0";
 894
 895     if (2 * @values + 2 > $special_case_len) {
 896         $special_case_len = 2 * @values + 2;
 897     }
 898
 899     push @special_cases, $result;
 900
 901     #
 902     # We encode special cases in the surrogate pair space
 903     #
 904     $value[$code] = 0xD800 + scalar(@special_cases) - 1;
 905 }
 906
 907 sub output_special_case_table
 908 {
 909     my $out = shift;
 910
 911     print $out <<EOT;
 912
 913 /* Table of special cases for case conversion; each record contains
 914  * First, the best single character mapping to lowercase if Lu,
 915  * and to uppercase if Ll, followed by the output mapping for the two cases
 916  * other than the case of the codepoint, in the order [Ll],[Lu],[Lt],
 917  * separated and terminated by a double NUL.
 918  */
 919 static const unsigned char special_case_table[][$special_case_len] = {
 920 EOT
 921
 922     for $case (@special_cases) {
 923         print $out qq( "$case",\n);
 924     }
 925
 926     print $out <<EOT;
 927 };
 928
 929 EOT
 930
 931     print STDERR "Generated ", ($special_case_len * scalar @special_cases), " bytes in special case table\n";
 932 }
 933
 934 sub enumerate_ordered
 935 {
 936     my ($array) = @_;
 937
 938     my $n = 0;
 939     for my $code (sort { $a <=> $b } keys %$array) {
 940         if ($array->{$code} == 1) {
 941             delete $array->{$code};
 942             next;
 943         }
 944         $array->{$code} = $n++;
 945     }
 946
 947     return $n;
 948 }
 949
 950 sub output_composition_table
 951 {
 952     print STDERR "Generating composition table\n";
 953
 954     local ($bytes_out) = 0;
 955
 956     my %first;
 957     my %second;
 958
 959     # First we need to go through and remove decompositions
 960     # starting with a non-starter, and single-character
 961     # decompositions. At the same time, record
 962     # the first and second character of each decomposition
 963
 964     for $code (keys %compositions) {
 965         @values = map { hex ($_) } split /\s+/, $compositions{$code};
 966         if ($cclass[$values[0]]) {
 967             delete $compositions{$code};
 968             next;
 969         }
 970         if (@values == 1) {
 971             delete $compositions{$code};
 972             next;
 973         }
 974         if (@values != 2) {
 975             die "$code has more than two elements in its decomposition!\n";
 976         }
 977
 978         if (exists $first{$values[0]}) {
 979             $first{$values[0]}++;
 980         } else {
 981             $first{$values[0]} = 1;
 982         }
 983     }
 984
 985     # Assign integer indicices, removing singletons
 986     my $n_first = enumerate_ordered (\%first);
 987
 988     # Now record the second character if each (non-singleton) decomposition
 989     for $code (keys %compositions) {
 990         @values = map { hex ($_) } split /\s+/, $compositions{$code};
 991
 992         if (exists $first{$values[0]}) {
 993             if (exists $second{$values[1]}) {
 994                 $second{$values[1]}++;
 995             } else {
 996                 $second{$values[1]} = 1;
 997             }
 998         }
 999     }
1000
1001     # Assign integer indices, removing duplicate
1002     my $n_second = enumerate_ordered (\%second);
1003
1004     # Build reverse table
1005
1006     my @first_singletons;
1007     my @second_singletons;
1008     my %reverse;
1009     for $code (keys %compositions) {
1010         @values = map { hex ($_) } split /\s+/, $compositions{$code};
1011
1012         my $first = $first{$values[0]};
1013         my $second = $second{$values[1]};
1014
1015         if (defined $first && defined $second) {
1016             $reverse{"$first|$second"} = $code;
1017         } elsif (!defined $first) {
1018             push @first_singletons, [ $values[0], $values[1], $code ];
1019         } else {
1020             push @second_singletons, [ $values[1], $values[0], $code ];
1021         }
1022     }
1023
1024     @first_singletons = sort { $a->[0] <=> $b->[0] } @first_singletons;
1025     @second_singletons = sort { $a->[0] <=> $b->[0] } @second_singletons;
1026
1027     my %vals;
1028
1029     open OUT, ">gunicomp.h" or die "Cannot open gunicomp.h: $!\n";
1030
1031     # Assign values in lookup table for all code points involved
1032
1033     my $total = 1;
1034     my $last = 0;
1035     printf OUT "#define COMPOSE_FIRST_START %d\n", $total;
1036     for $code (keys %first) {
1037         $vals{$code} = $first{$code} + $total;
1038         $last = $code if $code > $last;
1039     }
1040     $total += $n_first;
1041     $i = 0;
1042     printf OUT "#define COMPOSE_FIRST_SINGLE_START %d\n", $total;
1043     for $record (@first_singletons) {
1044         my $code = $record->[0];
1045         $vals{$code} = $i++ + $total;
1046         $last = $code if $code > $last;
1047     }
1048     $total += @first_singletons;
1049     printf OUT "#define COMPOSE_SECOND_START %d\n", $total;
1050     for $code (keys %second) {
1051         $vals{$code} = $second{$code} + $total;
1052         $last = $code if $code > $last;
1053     }
1054     $total += $n_second;
1055     $i = 0;
1056     printf OUT "#define COMPOSE_SECOND_SINGLE_START %d\n\n", $total;
1057     for $record (@second_singletons) {
1058         my $code = $record->[0];
1059         $vals{$code} = $i++ + $total;
1060         $last = $code if $code > $last;
1061     }
1062
1063     # Output lookup table
1064
1065     my @row;
1066     $table_index = 0;
1067     printf OUT "static const int compose_data[][256] = {\n";
1068     for (my $count = 0; $count <= $last; $count += 256)
1069     {
1070         $row[$count / 256] = &print_row ($count, 2, sub { exists $vals{$_[0]} ? $vals{$_[0]} : 0; });
1071     }
1072     printf OUT "\n};\n\n";
1073
1074     print OUT "static const short compose_table[256] = {\n";
1075     for (my $count = 0; $count <= $last; $count += 256)
1076     {
1077         print OUT ",\n" if $count > 0;
1078         print OUT "  ", $row[$count / 256];
1079         $bytes_out += 4;
1080     }
1081     print OUT "\n};\n\n";
1082
1083     # Output first singletons
1084
1085     print OUT "static const unsigned long compose_first_single[][2] = {\n";
1086     $i = 0;
1087     for $record (@first_singletons) {
1088         print OUT ",\n" if $i++ > 0;
1089         printf OUT " { %#06x, %#06x }", $record->[1], $record->[2];
1090     }
1091     print OUT "\n};\n";
1092
1093     $bytes_out += @first_singletons * 4;
1094
1095     # Output second singletons
1096
1097     print OUT "static const unsigned long compose_second_single[][2] = {\n";
1098     $i = 0;
1099     for $record (@second_singletons) {
1100         print OUT ",\n" if $i++ > 0;
1101         printf OUT " { %#06x, %#06x }", $record->[1], $record->[2];
1102     }
1103     print OUT "\n};\n";
1104
1105     $bytes_out += @second_singletons * 4;
1106
1107     # Output array of composition pairs
1108
1109     print OUT <<EOT;
1110 static const int compose_array[$n_first][$n_second] = {
1111 EOT
1112
1113     for (my $i = 0; $i < $n_first; $i++) {
1114         print OUT ",\n" if $i;
1115         print OUT " { ";
1116         for (my $j = 0; $j < $n_second; $j++) {
1117             print OUT ", " if $j;
1118             if (exists $reverse{"$i|$j"}) {
1119                 printf OUT "%#06x", $reverse{"$i|$j"};
1120             } else {
1121                 print OUT "     0";
1122             }
1123         }
1124         print OUT " }";
1125     }
1126     print OUT "\n";
1127
1128     print OUT <<EOT;
1129 };
1130 EOT
1131
1132     $bytes_out += $n_first * $n_second * 2;
1133
1134     printf STDERR "Generated %d bytes in compose tables\n", $bytes_out;
1135 }
1136
1137 sub output_casefold_table
1138 {
1139     my $out = shift;
1140
1141     print $out <<EOT;
1142
1143 /* Table of casefolding cases that can't be derived by lowercasing
1144  */
1145 static const struct {
1146   guint16 ch;
1147   gchar data[$casefoldlen];
1148 } casefold_table[] = {
1149 EOT
1150
1151    @casefold = sort { $a->[0] <=> $b->[0] } @casefold;
1152
1153    for $case (@casefold) {
1154        $code = $case->[0];
1155        $string = $case->[1];
1156        print $out sprintf(qq({ %#04x, "$string" },\n), $code);
1157
1158    }
1159
1160     print $out <<EOT;
1161 };
1162
1163 EOT
1164
1165    my $recordlen = (2+$casefoldlen+1) & ~1;
1166    printf "Generated %d bytes for casefold table\n", $recordlen * @casefold;
1167 }
1168
1169
1170