#!/usr/bin/perl -w # unicode-muncher.pl -- generate Unicode database for java.lang.Character # Copyright (C) 1998, 2002 Free Software Foundation, Inc. # # This file is part of GNU Classpath. # # GNU Classpath is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # GNU Classpath is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with GNU Classpath; see the file COPYING. If not, write to the # Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA # 02111-1307 USA. # # Linking this library statically or dynamically with other modules is # making a combined work based on this library. Thus, the terms and # conditions of the GNU General Public License cover the whole # combination. # # As a special exception, the copyright holders of this library give you # permission to link this library with independent modules to produce an # executable, regardless of the license terms of these independent # modules, and to copy and distribute the resulting executable under # terms of your choice, provided that you also meet, for each linked # independent module, the terms and conditions of the license of that # module. An independent module is a module which is not derived from # or based on this library. If you modify this library, you may extend # this exception to your version of the library, but you are not # obligated to do so. If you do not wish to do so, delete this # exception statement from your version. # Code for reading UnicodeData.txt and generating the code for # gnu.java.lang.CharData. For now, the relevant Unicode definition files # are found in doc/unicode/. # # Inspired by code from Jochen Hoenicke. # author Eric Blake # # Usage: ./unicode-muncher # where is obtained from www.unicode.org (named # UnicodeData-3.0.0.txt for Unicode version 3.0.0), and # is the final location for the Java interface gnu.java.lang.CharData. # As of JDK 1.4, use Unicode version 3.0.0 for best results. ## ## Convert a 16-bit integer to a Java source code String literal character ## sub javaChar($) { my ($char) = @_; die "Out of range: $char\n" if $char < -0x8000 or $char > 0xffff; $char += 0x10000 if $char < 0; # Special case characters that must be escaped, or are shorter as ASCII return sprintf("\\%03o", $char) if $char < 0x20; return "\\\"" if $char == 0x22; return "\\\\" if $char == 0x5c; return pack("C", $char) if $char < 0x7f; return sprintf("\\u%04x", $char); } ## ## Convert the text UnicodeData file from www.unicode.org into a Java ## interface with string constants holding the compressed information. ## my @TYPECODES = qw(Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp Cc Cf SKIPPED Co Cs Pd Ps Pe Pc Po Sm Sc Sk So Pi Pf); my @DIRCODES = qw(L R AL EN ES ET AN CS NSM BN B S WS ON LRE LRO RLE RLO PDF); my $NOBREAK_FLAG = 32; my $MIRRORED_FLAG = 64; my @info = (); my $titlecase = ""; my $count = 0; my $range = 0; die "Usage: $0 " unless @ARGV == 2; open (UNICODE, "< $ARGV[0]") || die "Can't open Unicode attribute file: $!\n"; # Stage 1: Parse the attribute file $| = 1; print "GNU Classpath Unicode Attribute Database Generator 2.0\n"; print "Copyright (C) 1998, 2002 Free Software Foundation, Inc.\n"; print "Parsing attributes file"; while() { print "." unless $count++ % 1000; chomp; s/\r//g; my ($ch, $name, $category, undef, $bidir, $decomp, undef, undef, $numeric, $mirrored, undef, undef, $upcase, $lowcase, $title) = split ';'; $ch = hex($ch); next if $ch > 0xffff; # Ignore surrogate pairs, since Java does my ($type, $numValue, $upperchar, $lowerchar, $direction); $type = 0; while ($category !~ /^$TYPECODES[$type]$/) { if (++$type == @TYPECODES) { die "$ch: Unknown type: $category"; } } $type |= $NOBREAK_FLAG if ($decomp =~ /noBreak/); $type |= $MIRRORED_FLAG if ($mirrored =~ /Y/); if ($numeric =~ /^[0-9]+$/) { $numValue = $numeric; die "numValue too big: $ch, $numValue\n" if $numValue >= 0x7fff; } elsif ($numeric eq "") { # Special case sequences of 'a'-'z' if ($ch >= 0x0041 && $ch <= 0x005a) { $numValue = $ch - 0x0037; } elsif ($ch >= 0x0061 && $ch <= 0x007a) { $numValue = $ch - 0x0057; } elsif ($ch >= 0xff21 && $ch <= 0xff3a) { $numValue = $ch - 0xff17; } elsif ($ch >= 0xff41 && $ch <= 0xff5a) { $numValue = $ch - 0xff37; } else { $numValue = -1; } } else { $numValue = -2; } $upperchar = $upcase ? hex($upcase) - $ch : 0; $lowerchar = $lowcase ? hex($lowcase) - $ch : 0; if ($title ne $upcase) { my $titlechar = $title ? hex($title) : $ch; $titlecase .= pack("n2", $ch, $titlechar); } $direction = 0; while ($bidir !~ /^$DIRCODES[$direction]$/) { if (++$direction == @DIRCODES) { $direction = -1; last; } } if ($range) { die "Expecting end of range at $ch\n" unless $name =~ /Last>$/; for ($range + 1 .. $ch - 1) { $info[$_] = pack("n5", $type, $numValue, $upperchar, $lowerchar, $direction); } $range = 0; } elsif ($name =~ /First>$/) { $range = $ch; } $info[$ch] = pack("n5", $type, $numValue, $upperchar, $lowerchar, $direction); } close UNICODE; # Stage 2: Compress the data structures printf "\nCompressing data structures"; $count = 0; my $info = (); my %charhash = (); my @charinfo = (); for my $ch (0 .. 0xffff) { print "." unless $count++ % 0x1000; if (! defined $info[$ch]) { $info[$ch] = pack("n5", 0, -1, 0, 0, -1); } my ($type, $numVal, $upper, $lower, $direction) = unpack("n5", $info[$ch]); if (! exists $charhash{$info[$ch]}) { push @charinfo, [ $numVal, $upper, $lower, $direction ]; $charhash{$info[$ch]} = $#charinfo; } $info .= pack("n", ($charhash{$info[$ch]} << 7) | $type); } my $charlen = @charinfo; my $bestshift; my $bestest = 1000000; my $bestblkstr; die "Too many unique character entries: $charlen\n" if $charlen > 512; print "\nUnique character entries: $charlen\n"; for my $i (3 .. 8) { my $blksize = 1 << $i; my %blocks = (); my @blkarray = (); my ($j, $k); print "shift: $i"; for ($j = 0; $j < 0x10000; $j += $blksize) { my $blkkey = substr $info, 2 * $j, 2 * $blksize; if (! exists $blocks{$blkkey}) { push @blkarray, $blkkey; $blocks{$blkkey} = $#blkarray; } } my $blknum = @blkarray; my $blocklen = $blknum * $blksize; printf " before %5d", $blocklen; # Now we try to pack the blkarray as tight as possible by finding matching # heads and tails. for ($j = $blksize - 1; $j > 0; $j--) { my %tails = (); for $k (0 .. $#blkarray) { next if ! defined $blkarray[$k]; my $len = length $blkarray[$k]; my $tail = substr $blkarray[$k], $len - $j * 2; if (exists $tails{$tail}) { push @{$tails{$tail}}, $k; } else { $tails{$tail} = [ $k ]; } } # tails are calculated, now calculate the heads and merge. BLOCK: for $k (0 .. $#blkarray) { next if ! defined $blkarray[$k]; my $tomerge = $k; while (1) { my $head = substr($blkarray[$tomerge], 0, $j * 2); my $entry = $tails{$head}; next BLOCK if ! defined $entry; my $other = shift @{$entry}; if ($other == $tomerge) { if (@{$entry}) { push @{$entry}, $other; $other = shift @{$entry}; } else { push @{$entry}, $other; next BLOCK; } } if (@{$entry} == 0) { delete $tails{$head}; } # a match was found my $merge = $blkarray[$other] . substr($blkarray[$tomerge], $j * 2); $blocklen -= $j; $blknum--; if ($other < $tomerge) { $blkarray[$tomerge] = undef; $blkarray[$other] = $merge; my $len = length $merge; my $tail = substr $merge, $len - $j * 2; $tails{$tail} = [ map { $_ == $tomerge ? $other : $_ } @{$tails{$tail}} ]; next BLOCK; } $blkarray[$tomerge] = $merge; $blkarray[$other] = undef; } } } my $blockstr; for $k (0 .. $#blkarray) { $blockstr .= $blkarray[$k] if defined $blkarray[$k]; } die "Unexpected $blocklen" if length($blockstr) != 2 * $blocklen; my $estimate = 2 * $blocklen + (0x20000 >> $i); printf " after merge %5d: %6d bytes\n", $blocklen, $estimate; if ($estimate < $bestest) { $bestest = $estimate; $bestshift = $i; $bestblkstr = $blockstr; } } my @blocks; my $blksize = 1 << $bestshift; for (my $j = 0; $j < 0x10000; $j += $blksize) { my $blkkey = substr $info, 2 * $j, 2 * $blksize; my $index = index $bestblkstr, $blkkey; while ($index & 1) { die "not found: $j" if $index == -1; $index = index $bestblkstr, $blkkey, $index + 1; } push @blocks, ($index / 2 - $j) & 0xffff; } # Phase 3: Generate the file die "UTF-8 limit of blocks may be exceeded: " . scalar(@blocks) . "\n" if @blocks > 0xffff / 3; die "UTF-8 limit of data may be exceeded: " . length($bestblkstr) . "\n" if length($bestblkstr) > 0xffff / 3; { print "Generating $ARGV[1] with shift of $bestshift"; my ($i, $j); open OUTPUT, "> $ARGV[1]" or die "Failed creating output file: $!\n"; print OUTPUT <$ARGV[0], by some perl scripts. * This Unicode definition file can be found on the * http://www.unicode.org website. * JDK 1.4 uses Unicode version 3.0.0. * * The data is stored as string constants, but Character will convert these * Strings to their respective char[] components. The field * BLOCKS stores the offset of a block of 2SHIFT * characters within DATA. The DATA field, in turn, stores * information about each character in the low order bits, and an offset * into the attribute tables UPPER, LOWER, * NUM_VALUE, and DIRECTION. Notice that the * attribute tables are much smaller than 0xffff entries; as many characters * in Unicode share common attributes. Finally, there is a listing for * TITLE exceptions (most characters just have the same * title case as upper case). * * \@author scripts/unicode-muncher.pl (written by Jochen Hoenicke, * Eric Blake) * \@see Character */ public interface CharData { /** * The character shift amount to look up the block offset. In other words, * (char) (BLOCKS.value[ch >> SHIFT] + ch) is the index where * ch is described in DATA. */ int SHIFT = $bestshift; /** * The mapping of character blocks to their location in DATA. * Each entry has been adjusted so that the 16-bit sum with the desired * character gives the actual index into DATA. */ String BLOCKS EOF for ($i = 0; $i < @blocks / 11; $i++) { print OUTPUT $i ? "\n + \"" : " = \""; for $j (0 .. 10) { last if @blocks <= $i * 11 + $j; my $val = $blocks[$i * 11 + $j]; print OUTPUT javaChar($val); } print OUTPUT "\""; } print OUTPUT <UPPER to determine their titlecase). The listing * is a sequence of character pairs; converting the first character of the * pair to titlecase produces the second character. */ String TITLE EOF $len = length($titlecase) / 2; for ($i = 0; $i < $len / 11; $i++) { print OUTPUT $i ? "\n + \"" : " = \""; for $j (0 .. 10) { last if $len <= $i * 11 + $j; my $val = unpack "n", substr($titlecase, 2 * ($i*11 + $j), 2); print OUTPUT javaChar($val); } print OUTPUT "\""; } print OUTPUT ";\n}\n"; close OUTPUT; } print "\nDone.\n";