gcc/libjava/chartables.pl

# chartables.pl - A perl program to generate tables for use by the
# Character class.

# Copyright (C) 1998, 1999  Red Hat, Inc.
#
# This file is part of libjava.
# 
# This software is copyrighted work licensed under the terms of the
# Libjava License.  Please consult the file "LIBJAVA_LICENSE" for
# details.

# This program requires a `unidata.txt' file of the form distributed
# on the Unicode 2.0 CD ROM.  Or, get it more conveniently here:
# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData-Latest.txt
# Version `2.1.8' of this file was last used to update the Character class.

# Written using "Java Class Libraries", 2nd edition, ISBN 0-201-31002-3
# "The Java Language Specification", ISBN 0-201-63451-1
# plus online API docs for JDK 1.2 beta from http://www.javasoft.com.

# Usage: perl chartables.pl [-n] UnicodeData-VERSION.txt
# If this exits with nonzero status, then you must investigate the
# cause of the problem.
# Diagnostics and other information to stderr.
# This creates the new include/java-chartables.h and
# include/java-chardecomp.h files directly.
# With -n, the files are not created, but all processing
# still occurs.

# Fields in the table.
$CODE = 0;
$NAME = 1;
$CATEGORY = 2;
$DECOMPOSITION = 5;
$DECIMAL = 6;
$DIGIT = 7;
$NUMERIC = 8;
$UPPERCASE = 12;
$LOWERCASE = 13;
$TITLECASE = 14;

# A special case.
$TAMIL_DIGIT_ONE  = 0x0be7;
$TAMIL_DIGIT_NINE = 0x0bef;

# These are endpoints of legitimate gaps in the tables.
$CJK_IDEOGRAPH_END = 0x9fa5;
$HANGUL_END = 0xd7a3;
$HIGH_SURROGATE_END = 0xdb7f;
$PRIVATE_HIGH_SURROGATE_END = 0xdbff;
$LOW_SURROGATE_END = 0xdfff;
$PRIVATE_END = 0xf8ff;

%title_to_upper = ();
%title_to_lower = ();
%numerics  = ();
%name = ();

@digit_start = ();
@digit_end   = ();

@space_start = ();
@space_end   = ();

# @letter_start = ();
# @letter_end   = ();

@all_start = ();
@all_end   = ();
@all_cats  = ();

@upper_start = ();
@upper_end   = ();
@upper_map   = ();
%upper_anom  = ();

@lower_start = ();
@lower_end   = ();
@lower_map   = ();
%lower_anom  = ();

@attributes = ();

# There are a few characters which actually need two attributes.
# These are special-cased.
$ROMAN_START = 0x2160;
$ROMAN_END   = 0x217f;
%second_attributes = ();

$prevcode = -1;
$status = 0;

%category_map =
(
 'Mn' => 'NON_SPACING_MARK',
 'Mc' => 'COMBINING_SPACING_MARK',
 'Me' => 'ENCLOSING_MARK',
 'Nd' => 'DECIMAL_DIGIT_NUMBER',
 'Nl' => 'LETTER_NUMBER',
 'No' => 'OTHER_NUMBER',
 'Zs' => 'SPACE_SEPARATOR',
 'Zl' => 'LINE_SEPARATOR',
 'Zp' => 'PARAGRAPH_SEPARATOR',
 'Cc' => 'CONTROL',
 'Cf' => 'FORMAT',
 'Cs' => 'SURROGATE',
 'Co' => 'PRIVATE_USE',
 'Cn' => 'UNASSIGNED',
 'Lu' => 'UPPERCASE_LETTER',
 'Ll' => 'LOWERCASE_LETTER',
 'Lt' => 'TITLECASE_LETTER',
 'Lm' => 'MODIFIER_LETTER',
 'Lo' => 'OTHER_LETTER',
 'Pc' => 'CONNECTOR_PUNCTUATION',
 'Pd' => 'DASH_PUNCTUATION',
 'Ps' => 'START_PUNCTUATION',
 'Pe' => 'END_PUNCTUATION',
 'Pi' => 'START_PUNCTUATION',
 'Pf' => 'END_PUNCTUATION',
 'Po' => 'OTHER_PUNCTUATION',
 'Sm' => 'MATH_SYMBOL',
 'Sc' => 'CURRENCY_SYMBOL',
 'Sk' => 'MODIFIER_SYMBOL',
 'So' => 'OTHER_SYMBOL'
 );

# These maps characters to their decompositions.
%canonical_decomposition = ();
%full_decomposition = ();


# Handle `-n' and open output files.
local ($f1, $f2) = ('include/java-chartables.h',
		    'include/java-chardecomp.h');
if ($ARGV[0] eq '-n')
{
    shift @ARGV;
    $f1 = '/dev/null';
    $f2 = '/dev/null';
}

open (CHARTABLE, "> $f1");
open (DECOMP, "> $f2");

# Process the Unicode file.
while (<>)
{
    chop;
    # Specify a limit for split so that we pick up trailing fields.
    # We make the limit larger than we need, to catch the case where
    # there are extra fields.
    @fields = split (';', $_, 30);
    # Convert code to number.
    $ncode = hex ($fields[$CODE]);

    if ($#fields != 14)
    {
	print STDERR ("Entry for \\u", $fields[$CODE],
		      " has wrong number of fields: ", $#fields, "\n");
    }

    $name{$fields[$CODE]} = $fields[$NAME];

    # If we've found a gap in the table, fill it in.
    if ($ncode != $prevcode + 1)
    {
	&process_gap (*fields, $prevcode, $ncode);
    }

    &process_char (*fields, $ncode);

    $prevcode = $ncode;
}

if ($prevcode != 0xffff)
{
    # Setting of `fields' parameter doesn't matter here.
    &process_gap (*fields, $prevcode, 0x10000);
}

print CHARTABLE "// java-chartables.h - Character tables for java.lang.Character -*- c++ -*-\n\n";
print CHARTABLE "#ifndef __JAVA_CHARTABLES_H__\n";
print CHARTABLE "#define __JAVA_CHARTABLES_H__\n\n";
print CHARTABLE "// These tables are automatically generated by the chartables.pl\n";
print CHARTABLE "// script.  DO NOT EDIT the tables.  Instead, fix the script\n";
print CHARTABLE "// and run it again.\n\n";
print CHARTABLE "// This file should only be included by natCharacter.cc\n\n";


$bytes = 0;

# Titlecase mapping tables.
if ($#title_to_lower != $#title_to_upper)
{
    # If this fails we need to reimplement toTitleCase.
    print STDERR "titlecase mappings have different sizes\n";
    $status = 1;
}
# Also ensure that the tables are entirely parallel.
foreach $key (sort keys %title_to_lower)
{
    if (! defined $title_to_upper{$key})
    {
	print STDERR "titlecase mappings have different entries\n";
	$status = 1;
    }
}
&print_single_map ("title_to_lower_table", %title_to_lower);
&print_single_map ("title_to_upper_table", %title_to_upper);

print CHARTABLE "#ifdef COMPACT_CHARACTER\n\n";

printf CHARTABLE "#define TAMIL_DIGIT_ONE 0x%04x\n\n", $TAMIL_DIGIT_ONE;

# All numeric values.
&print_numerics;

# Digits only.
&print_block ("digit_table", *digit_start, *digit_end);

# Space characters.
&print_block ("space_table", *space_start, *space_end);

# Letters.  We used to generate a separate letter table.  But this
# doesn't really seem worthwhile.  Simply using `all_table' saves us
# about 800 bytes, and only adds 3 table probes to isLetter.
# &print_block ("letter_table", *letter_start, *letter_end);

# Case tables.
&print_case_table ("upper", *upper_start, *upper_end, *upper_map, *upper_anom);
&print_case_table ("lower", *lower_start, *lower_end, *lower_map, *lower_anom);

# Everything else.
&print_all_block (*all_start, *all_end, *all_cats);

print CHARTABLE "#else /* COMPACT_CHARACTER */\n\n";

printf CHARTABLE "#define ROMAN_START 0x%04x\n", $ROMAN_START;
printf CHARTABLE "#define ROMAN_END   0x%04x\n\n", $ROMAN_END;

&print_fast_tables (*all_start, *all_end, *all_cats,
		    *attributes, *second_attributes);

print CHARTABLE "#endif /* COMPACT_CHARACTER */\n\n";

print CHARTABLE "#endif /* __JAVA_CHARTABLES_H__ */\n";

printf STDERR "Approximately %d bytes of data generated (compact case)\n",
    $bytes;


# Now generate decomposition tables.
printf DECOMP "// java-chardecomp.h - Decomposition character tables -*- c++ -*-\n\n";
printf DECOMP "#ifndef __JAVA_CHARDECOMP_H__\n";
printf DECOMP "#define __JAVA_CHARDECOMP_H__\n\n";
print DECOMP "// These tables are automatically generated by the chartables.pl\n";
print DECOMP "// script.  DO NOT EDIT the tables.  Instead, fix the script\n";
print DECOMP "// and run it again.\n\n";
print DECOMP "// This file should only be included by natCollator.cc\n\n";

print DECOMP "struct decomp_entry\n{\n";
print DECOMP "  jchar key;\n";
print DECOMP "  const char *value;\n";
print DECOMP "};\n\n";

&write_decompositions;

printf DECOMP "#endif /* __JAVA_CHARDECOMP_H__ */\n";


close (CHARTABLE);
close (DECOMP);

exit $status;


# Process a gap in the space.
sub process_gap
{
    local (*fields, $prevcode, $ncode) = @_;
    local (@gap_fields, $i);

    if ($ncode == $CJK_IDEOGRAPH_END
	|| $ncode == $HANGUL_END
	|| $ncode == $HIGH_SURROGATE_END
	|| $ncode == $PRIVATE_HIGH_SURROGATE_END
	|| $ncode == $LOW_SURROGATE_END
	|| $ncode == $PRIVATE_END)
    {
	# The characters in the gap we just found are known to
	# have the same properties as the character at the end of
	# the gap.
	@gap_fields = @fields;
    }
    else
    {
	# This prints too much to be enabled.
	# print STDERR "Gap found at \\u", $fields[$CODE], "\n";
	@gap_fields = ('', '', 'Cn', '', '', '', '', '', '', '', '',
		       '', '', '', '');
    }

    for ($i = $prevcode + 1; $i < $ncode; ++$i)
    {
	$gap_fields[$CODE] = sprintf ("%04x", $i);
	$gap_fields[$NAME] = "CHARACTER " . $gap_fields[$CODE];
	&process_char (*gap_fields, $i);
    }
}

# Process a single character.
sub process_char
{
    local (*fields, $ncode) = @_;

    if ($fields[$DECOMPOSITION] ne '')
    {
	&add_decomposition ($ncode, $fields[$DECOMPOSITION]);
    }

    # If this is a titlecase character, mark it.
    if ($fields[$CATEGORY] eq 'Lt')
    {
	$title_to_upper{$fields[$CODE]} = $fields[$UPPERCASE];
	$title_to_lower{$fields[$CODE]} = $fields[$LOWERCASE];
    }
    else
    {
	# For upper and lower case mappings, we try to build compact
	# tables that map range onto range.  We specifically want to
	# avoid titlecase characters.  Java specifies a range check to
	# make sure the character is not between 0x2000 and 0x2fff.
	# We avoid that here because we need to generate table entries
	# -- toLower and toUpper still work in that range.
	if ($fields[$UPPERCASE] eq ''
	    && ($fields[$LOWERCASE] ne ''
		|| $fields[$NAME] =~ /CAPITAL (LETTER|LIGATURE)/))
	{
	    if ($fields[$LOWERCASE] ne '')
	    {
		&update_case_block (*upper_start, *upper_end, *upper_map,
				    $fields[$CODE], $fields[$LOWERCASE]);
		&set_attribute ($ncode, hex ($fields[$LOWERCASE]));
	    }
	    else
	    {
		$upper_anom{$fields[$CODE]} = 1;
	    }
	}
	elsif ($fields[$LOWERCASE] ne '')
	{
	    print STDERR ("Java missed upper case char \\u",
			  $fields[$CODE], "\n");
	}
	elsif ($fields[$CATEGORY] eq 'Lu')
	{
	    # This case is for letters which are marked as upper case
	    # but for which there is no lower case equivalent.  For
	    # instance, LATIN LETTER YR.
	}

	if ($fields[$LOWERCASE] eq ''
	    && ($fields[$UPPERCASE] ne ''
		|| $fields[$NAME] =~ /SMALL (LETTER|LIGATURE)/))
	{
	    if ($fields[$UPPERCASE] ne '')
	    {
		&update_case_block (*lower_start, *lower_end, *lower_map,
				    $fields[$CODE], $fields[$UPPERCASE]);
		&set_attribute ($ncode, hex ($fields[$UPPERCASE]));
	    }
	    else
	    {
		$lower_anom{$fields[$CODE]} = 1;
	    }
	}
	elsif ($fields[$UPPERCASE] ne '')
	{
	    print STDERR ("Java missed lower case char \\u",
			  $fields[$CODE], "\n");
	}
	elsif ($fields[$CATEGORY] eq 'Ll')
	{
	    # This case is for letters which are marked as lower case
	    # but for which there is no upper case equivalent.  For
	    # instance, FEMININE ORDINAL INDICATOR.
	}
    }


    # If we have a non-decimal numeric value, add it to the list.
    if ($fields[$CATEGORY] eq 'Nd'
	&& ($ncode < 0x2000 || $ncode > 0x2fff)
	&& $fields[$NAME] =~ /DIGIT/)
    {
	# This is a digit character that is handled elsewhere.
    }
    elsif ($fields[$DIGIT] ne '' || $fields[$NUMERIC] ne '')
    {
	# Do a simple check.
	if ($fields[$DECIMAL] ne '')
	{
	    # This catches bugs in an earlier implementation of
	    # chartables.pl.  Now it is here for historical interest
	    # only.
	    # print STDERR ("Character \u", $fields[$CODE],
	    # " would have been missed as digit\n");
	}

	local ($val) = $fields[$DIGIT];
	$val = $fields[$NUMERIC] if $val eq '';
	local ($ok) = 1;

	# If we have a value which is not a positive integer, then we
	# set the value to -2 to make life easier for
	# Character.getNumericValue.
	if ($val !~ m/^[0-9]+$/)
	{
	    if ($fields[$CATEGORY] ne 'Nl'
		&& $fields[$CATEGORY] ne 'No')
	    {
		# This shows a few errors in the Unicode table.  These
		# characters have a missing Numeric field, and the `N'
		# for the mirrored field shows up there instead.  I
		# reported these characters to errata@unicode.org on
		# Thu Sep 10 1998.  They said it will be fixed in the
		# 2.1.6 release of the tables.
		print STDERR ("Character \u", $fields[$CODE],
			      " has value but is not numeric; val = '",
			      $val, "'\n");
		# We skip these.
		$ok = 0;
	    }
	    $val = "-2";
	}

	if ($ok)
	{
	    $numerics{$fields[$CODE]} = $val;
	    &set_attribute ($ncode, $val);
	}
    }

    # We build a table that lists ranges of ordinary decimal values.
    # At each step we make sure that the digits are in the correct
    # order, with no holes, as this is assumed by Character.  If this
    # fails, reimplementation is required.  This implementation
    # dovetails nicely with the Java Spec, which has strange rules for
    # what constitutes a decimal value.  In particular the Unicode
    # name must contain the word `DIGIT'.  The spec doesn't directly
    # say that digits must have type `Nd' (or that their value must an
    # integer), but that can be inferred from the list of digits in
    # the book(s).  Currently the only Unicode characters whose name
    # includes `DIGIT' which would not fit are the Tibetan "half"
    # digits.
    if ($fields[$CATEGORY] eq 'Nd')
    {
	if (($ncode < 0x2000 || $ncode > 0x2fff)
	    && $fields[$NAME] =~ /DIGIT/)
	{
	    &update_digit_block (*digit_start, *digit_end, $fields[$CODE],
				 $fields[$DECIMAL]);
	    &set_attribute ($ncode, $fields[$DECIMAL]);
	}
	else
	{
	    # If this fails then Character.getType will fail.  We
	    # assume that things in `digit_table' are the only
	    # category `Nd' characters.
	    print STDERR ("Character \u", $fields[$CODE],
			  " is class Nd but not in digit table\n");
	    $status = 1;
	}
    }

    # Keep track of space characters.
    if ($fields[$CATEGORY] =~ /Z[slp]/)
    {
	&update_block (*space_start, *space_end, $fields[$CODE]);
    }

    # Keep track of letters.
    # if ($fields[$CATEGORY] =~ /L[ultmo]/)
    # {
    # 	&update_letter_block (*letter_start, *letter_end, $fields[$CODE],
    # 			      $fields[$CATEGORY]);
    # }

    # Keep track of all characters.  You might think we wouldn't have
    # to do this for uppercase letters, or other characters we already
    # "classify".  The problem is that this classification is
    # different.  E.g., \u216f is uppercase by Java rules, but is a
    # LETTER_NUMBER here.
    &update_all_block (*all_start, *all_end, *all_cats,
		       $fields[$CODE], $fields[$CATEGORY]);
}


# Called to add a new decomposition.
sub add_decomposition
{
    local ($ncode, $value) = @_;
    local ($is_full) = 0;
    local ($first) = 1;
    local (@decomp) = ();

    foreach (split (' ', $value))
    {
	if ($first && /^\<.*\>$/)
	{
	    $is_full = 1;
	}
	else
	{
	    push (@decomp, hex ($_));
	}
	$first = 0;
    }

    # We pack the value into a string because this means we can stick
    # with Perl 4 features.
    local ($s) = pack "I*", @decomp;
    if ($is_full)
    {
	$full_decomposition{$ncode} = $s;
    }
    else
    {
	$canonical_decomposition{$ncode} = $s;
    }
}

# Write a single decomposition table.
sub write_single_decomposition
{
    local ($name, $is_canon, %table) = @_;

    printf DECOMP "static const decomp_entry ${name}_decomposition[] =\n{\n";

    local ($key, @expansion, $char);
    local ($first_line) = 1;

    for ($key = 0; $key <= 65535; ++$key)
    {
	next if ! defined $table{$key};

	printf DECOMP ",\n"
	    unless $first_line;
	$first_line = 0;

	printf DECOMP "  { 0x%04x, \"", $key;

	# We represent the expansion as a series of bytes, terminated
	# with a double nul.  This is ugly, but relatively
	# space-efficient.  Most expansions are short, but there are a
	# few that are very long (e.g. \uFDFA).  This means that if we
	# chose a fixed-space representation we would waste a lot of
	# space.
	@expansion = unpack "I*", $table{$key};
	foreach $char (@expansion)
	{
	    printf DECOMP "\\x%02x\\x%02x", ($char / 256), ($char % 256);
	}

	printf DECOMP "\" }";
    }

    printf DECOMP "\n};\n\n";
}

sub write_decompositions
{
    &write_single_decomposition ('canonical', 1, %canonical_decomposition);
    &write_single_decomposition ('full', 0, %full_decomposition);
}

# We represent a block of characters with a pair of lists.  This
# function updates the pair to account for the new character.  Returns
# 1 if we added to the old block, 0 otherwise.
sub update_block
{
    local (*start, *end, $char) = @_;

    local ($nchar) = hex ($char);
    local ($count) = $#end;
    if ($count >= 0 && $end[$count] == $nchar - 1)
    {
	++$end[$count];
	return 1;
    }
    else
    {
	++$count;
	$start[$count] = $nchar;
	$end[$count] = $nchar;
    }
    return 0;
}

# Return true if we will be appending this character to the end of the
# existing block.
sub block_append_p
{
    local (*end, $char) = @_;
    return $#end >= 0 && $end[$#end] == $char - 1;
}

# This updates the digit block.  This table is much like an ordinary
# block, but it has an extra constraint.
sub update_digit_block
{
    local (*start, *end, $char, $value) = @_;

    &update_block ($start, $end, $char);
    local ($nchar) = hex ($char);

    # We want to make sure that the new digit's value is correct for
    # its place in the block.  However, we special-case Tamil digits,
    # since Tamil does not have a digit `0'.
    local ($count) = $#start;
    if (($nchar < $TAMIL_DIGIT_ONE || $nchar > $TAMIL_DIGIT_NINE)
	&& $nchar - $start[$count] != $value)
    {
	# If this fails then Character.digit_value will be wrong.
	print STDERR "Character \\u", $char, " violates digit constraint\n";
	$status = 1;
    }
}

# Update letter table.  We could be smart about avoiding upper or
# lower case letters, but it is much simpler to just track them all.
sub update_letter_block
{
    local (*start, *end, $char, $category) = @_;

    &update_block (*start, *end, $char);
}

# Update `all' table.  This table holds all the characters we don't
# already categorize for other reasons.  FIXME: if a given type has
# very few characters, we should just inline the code.  E.g., there is
# only one paragraph separator.
sub update_all_block
{
    local (*start, *end, *cats, $char, $category) = @_;

    local ($nchar) = hex ($char);
    local ($count) = $#end;
    if ($count >= 0
	&& $end[$count] == $nchar - 1
	&& $cats[$count] eq $category)
    {
	++$end[$count];
    }
    else
    {
	++$count;
	$start[$count] = $nchar;
	$end[$count] = $nchar;
	$cats[$count] = $category;
    }
}

# Update a case table.  We handle case tables specially because we
# want to map (e.g.) a block of uppercase characters directly onto the
# corresponding block of lowercase characters.  Therefore we generate
# a new entry when the block would no longer map directly.
sub update_case_block
{
    local (*start, *end, *map, $char, $mapchar) = @_;

    local ($nchar) = hex ($char);
    local ($nmap) = hex ($mapchar);

    local ($count) = $#end;
    if ($count >= 0
	&& $end[$count] == $nchar - 1
	&& $nchar - $start[$count] == $nmap - $map[$count])
    {
	++$end[$count];
    }
    else
    {
	++$count;
	$start[$count] = $nchar;
	$end[$count] = $nchar;
	$map[$count] = $nmap;
    }
}

# Set the attribute value for the character.  Each character can have
# only one attribute.
sub set_attribute
{
    local ($ncode, $attr) = @_;

    if ($attributes{$ncode} ne '' && $attributes{$ncode} ne $attr)
    {
	if ($ncode >= $ROMAN_START && $ncode <= $ROMAN_END)
	{
	    $second_attributes{$ncode} = $attr;
	}
	else
	{
	    printf STDERR "character \\u%04x already has attribute\n", $ncode;
	}
    }
    # Attributes can be interpreted as unsigned in some situations,
    # so we check against 65535.  This could cause errors -- we need
    # to check the interpretation here.
    elsif ($attr < -32768 || $attr > 65535)
    {
	printf STDERR "attribute out of range for character \\u%04x\n", $ncode;
    }
    else
    {
	$attributes{$ncode} = $attr;
    }
}


# Print a block table.
sub print_block
{
    local ($title, *start, *end) = @_;

    print CHARTABLE "static const jchar ", $title, "[][2] =\n";
    print CHARTABLE "  {\n";

    local ($i) = 0;
    while ($i <= $#start)
    {
	print CHARTABLE "    { ";
	&print_char ($start[$i]);
	print CHARTABLE ", ";
	&print_char ($end[$i]);
	print CHARTABLE " }";
	print CHARTABLE "," if ($i != $#start);
	print CHARTABLE "\n";
	++$i;
	$bytes += 4;		# Two bytes per char.
    }

    print CHARTABLE "  };\n\n";
}

# Print the numerics table.
sub print_numerics
{
    local ($i, $key, $count, @keys);

    $i = 0;
    @keys = sort keys %numerics;
    $count = @keys;

    print CHARTABLE "static const jchar numeric_table[] =\n";
    print CHARTABLE "  { ";
    foreach $key (@keys)
    {
	&print_char (hex ($key));
	++$i;
	print CHARTABLE ", " if $i < $count;
	# Print 5 per line.
	print CHARTABLE "\n    " if ($i % 5 == 0);
	$bytes += 2;		# One character.
    }
    print CHARTABLE " };\n\n";

    print CHARTABLE "static const jshort numeric_value[] =\n";
    print CHARTABLE "  { ";
    $i = 0;
    foreach $key (@keys)
    {
	print CHARTABLE $numerics{$key};
	if ($numerics{$key} > 32767 || $numerics{$key} < -32768)
	{
	    # This means our generated type info is incorrect.  We
	    # could just detect and work around this here, but I'm
	    # lazy.
	    print STDERR "numeric value won't fit in a short\n";
	    $status = 1;
	}
	++$i;
	print CHARTABLE ", " if $i < $count;
	# Print 10 per line.
	print CHARTABLE "\n    " if ($i % 10 == 0);
	$bytes += 2;		# One short.
    }
    print CHARTABLE " };\n\n";
}

# Print a table that maps one single letter onto another.  It assumes
# the map is index by char code.
sub print_single_map
{
    local ($title, %map) = @_;

    local (@keys) = sort keys %map;
    $num = @keys;
    print CHARTABLE "static const jchar ", $title, "[][2] =\n";
    print CHARTABLE "  {\n";
    $i = 0;
    for $key (@keys)
    {
	print CHARTABLE "    { ";
	&print_char (hex ($key));
	print CHARTABLE ", ";
	&print_char (hex ($map{$key}));
	print CHARTABLE " }";
	++$i;
	if ($i < $num)
	{
	    print CHARTABLE ",";
	}
	else
	{
	    print CHARTABLE " ";
	}
	print CHARTABLE "   // ", $name{$key}, "\n";
	$bytes += 4;		# Two bytes per char.
    }
    print CHARTABLE "  };\n\n";
}

# Print the `all' block.
sub print_all_block
{
    local (*start, *end, *cats) = @_;

    &print_block ("all_table", *start, *end);

    local ($i) = 0;
    local ($sum) = 0;
    while ($i <= $#start)
    {
	$sum += $end[$i] - $start[$i] + 1;
	++$i;
    }
    # We do this computation just to make sure it isn't cheaper to
    # simply list all the characters individually.
    printf STDERR ("all_table encodes %d characters in %d entries\n",
		   $sum, $#start + 1);

    print CHARTABLE "static const jbyte category_table[] =\n";
    print CHARTABLE "  { ";

    $i = 0;
    while ($i <= $#cats)
    {
	if ($i > 0 && $cats[$i] eq $cats[$i - 1])
	{
	    # This isn't an error.  We can have a duplicate because
	    # two ranges are not adjacent while the intervening
	    # characters are left out of the table for other reasons.
	    # We could exploit this to make the table a little smaller.
	    # printf STDERR "Duplicate all entry at \\u%04x\n", $start[$i];
	}
	print CHARTABLE 'java::lang::Character::', $category_map{$cats[$i]};
	print CHARTABLE ", " if ($i < $#cats);
	++$i;
	print CHARTABLE "\n    ";
	++$bytes;
    }
    print CHARTABLE "  };\n\n";
}

# Print case table.
sub print_case_table
{
    local ($title, *start, *end, *map, *anomalous) = @_;

    &print_block ($title . '_case_table', *start, *end);

    print CHARTABLE "static const jchar ", $title, "_case_map_table[] =\n";
    print CHARTABLE "  { ";

    local ($i) = 0;
    while ($i <= $#map)
    {
	&print_char ($map[$i]);
	print CHARTABLE ", " if $i < $#map;
	++$i;
	print CHARTABLE "\n    " if $i % 5 == 0;
	$bytes += 2;
    }
    print CHARTABLE "  };\n";


    local ($key, @keys);
    @keys = sort keys %anomalous;

    if ($title eq 'upper')
    {
	if ($#keys >= 0)
	{
	    # If these are found we need to change Character.isUpperCase.
	    print STDERR "Found anomalous upper case characters\n";
	    $status = 1;
	}
    }
    else
    {
	print CHARTABLE "\n";
	print CHARTABLE "static const jchar ", $title, "_anomalous_table[] =\n";
	print CHARTABLE "  { ";
	$i = 0;
	foreach $key (@keys)
	{
	    &print_char (hex ($key));
	    print CHARTABLE ", " if $i < $#keys;
	    ++$i;
	    print CHARTABLE "\n    " if $i % 5 == 0;
	    $bytes += 2;
	}
	print CHARTABLE "  };\n";
    }

    print CHARTABLE "\n";
}

# Print the type table and attributes table for the fast version.
sub print_fast_tables
{
    local (*start, *end, *cats, *atts, *second_atts) = @_;

    print CHARTABLE "static const jbyte type_table[] =\n{ ";

    local ($i, $j);
    for ($i = 0; $i <= $#cats; ++$i)
    {
	for ($j = $start[$i]; $j <= $end[$i]; ++$j)
	{
	    print CHARTABLE 'java::lang::Character::', $category_map{$cats[$i]};
	    print CHARTABLE "," if ($i < $#cats || $j < $end[$i]);
	    print CHARTABLE "\n    ";
	}
    }
    print CHARTABLE "\n };\n\n";

    print CHARTABLE "static const jshort attribute_table[] =\n{ ";
    for ($i = 0; $i <= 0xffff; ++$i)
    {
	$atts{$i} = 0 if ! defined $atts{$i};
	print CHARTABLE $atts{$i};
	print CHARTABLE ", " if $i < 0xffff;
	print CHARTABLE "\n    " if $i % 5 == 1;
    }
    print CHARTABLE "\n };\n\n";

    print CHARTABLE "static const jshort secondary_attribute_table[] =\n{ ";
    for ($i = $ROMAN_START; $i <= $ROMAN_END; ++$i)
    {
	print CHARTABLE $second_atts{$i};
	print CHARTABLE ", " if $i < $ROMAN_END;
	print CHARTABLE "\n    " if $i % 5 == 1;
    }
    print CHARTABLE "\n };\n\n";
}

# Print a character constant.
sub print_char
{
    local ($ncode) = @_;
    printf CHARTABLE "0x%04x", $ncode;
}