gcc/java/gen-table.pl

   1 #! /usr/bin/perl
   2
   3 #    Copyright (C) 2000, 2001 Free Software Foundation
   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-table.pl - Generate tables for gcj from Unicode data.
  21 # Usage: perl gen-table.pl DATA-FILE
  22 #
  23 # You can find the Unicode data file here:
  24 #   ftp://www.unicode.org/Public/3.0-Update1/UnicodeData-3.0.1.txt
  25 # Please update this URL when this program is used with a more
  26 # recent version of the table.  Note that this table cannot be
  27 # distributed with gcc.
  28 # This program should not be re-run indiscriminately.  Care must be
  29 # taken that what it generates is in sync with the Java specification.
  30
  31 # Names of fields in Unicode data table.
  32 $CODE = 0;
  33 $NAME = 1;
  34 $CATEGORY = 2;
  35 $COMBINING_CLASSES = 3;
  36 $BIDI_CATEGORY = 4;
  37 $DECOMPOSITION = 5;
  38 $DECIMAL_VALUE = 6;
  39 $DIGIT_VALUE = 7;
  40 $NUMERIC_VALUE = 8;
  41 $MIRRORED = 9;
  42 $OLD_NAME = 10;
  43 $COMMENT = 11;
  44 $UPPER = 12;
  45 $LOWER = 13;
  46 $TITLE = 14;
  47
  48 # Start of special-cased gaps in Unicode data table.
  49 %gaps = (
  50          0x4e00 => "CJK",
  51          0xac00 => "Hangul",
  52          0xd800 => "Unassigned High Surrogate",
  53          0xdb80 => "Private Use High Surrogate",
  54          0xdc00 => "Low Surrogate",
  55          0xe000 => "Private Use"
  56          );
  57
  58 # This lists control characters which are also considered whitespace.
  59 # This is a somewhat odd list, taken from the JCL definition of
  60 # Character.isIdentifierIgnorable.
  61 %whitespace_controls =
  62     (
  63      0x0009 => 1,
  64      0x000a => 1,
  65      0x000b => 1,
  66      0x000c => 1,
  67      0x000d => 1,
  68      0x001c => 1,
  69      0x001d => 1,
  70      0x001e => 1,
  71      0x001f => 1
  72      );
  73
  74 open (INPUT, "< $ARGV[0]") || exit 1;
  75
  76 $last_code = -1;
  77 while (<INPUT>)
  78 {
  79     chop;
  80     @fields = split (';', $_, 30);
  81     if ($#fields != 14)
  82     {
  83         print STDERR "Entry for $fields[$CODE] has wrong number of fields\n";
  84     }
  85
  86     $code = hex ($fields[$CODE]);
  87     last if $code > 0xffff;
  88     if ($code > $last_code + 1)
  89     {
  90         # Found a gap.
  91         if (defined $gaps{$code})
  92         {
  93             # Fill the gap with the last character read.
  94             @gfields = @fields;
  95         }
  96         else
  97         {
  98             # The gap represents undefined characters.  Only the type
  99             # matters.
 100             @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 101                         '', '', '', '');
 102         }
 103         for (++$last_code; $last_code < $code; ++$last_code)
 104         {
 105             $gfields{$CODE} = sprintf ("%04x", $last_code);
 106             &process_one ($last_code, @gfields);
 107         }
 108     }
 109     &process_one ($code, @fields);
 110     $last_code = $code;
 111 }
 112
 113 close (INPUT);
 114
 115 @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 116             '', '', '', '');
 117 for (++$last_code; $last_code < 0x10000; ++$last_code)
 118 {
 119     $gfields{$CODE} = sprintf ("%04x", $last_code);
 120     &process_one ($last_code, @gfields);
 121 }
 122 --$last_code;                   # Want last to be 0xFFFF.
 123
 124 &print_tables ($last_code);
 125
 126 exit 0;
 127
 128 # Process a single character.
 129 sub process_one
 130 {
 131     my ($code, @fields) = @_;
 132
 133     my $value = '';
 134     my $type = $fields[$CATEGORY];
 135
 136     # See if the character is a valid identifier start.
 137     if ($type =~ /L./           # Letter
 138         || $type eq 'Pc'        # Connecting punctuation
 139         || $type eq 'Sc')       # Currency symbol
 140     {
 141         $value = 'LETTER_START';
 142     }
 143
 144     # See if the character is a valid identifier member.
 145     if ($type =~ /L./           # Letter
 146         || $type eq 'Pc'        # Connecting punctuation
 147         || $type eq 'Sc'        # Currency symbol
 148         || $type =~ /N[dl]/     # Number: decimal or letter
 149         || $type =~ /M[nc]/     # Mark: non-spacing or combining
 150         || ($type eq 'Cc'       # Certain controls
 151             && ! defined $whitespace_controls{$code})
 152         || ($code >= 0x200c     # Join controls
 153             && $code <= 0x200f)
 154         || ($code >= 0x202a     # Bidi controls -- note that there
 155                                 # is a typo in the JCL where these are
 156                                 # concerned.
 157             && $code <= 0x202e)
 158         || ($code >= 0x206a     # Format controls
 159             && $code <= 0x206f)
 160         || $code == 0xfeff)     # ZWNBSP
 161     {
 162         if ($value eq '')
 163         {
 164             $value = 'LETTER_PART';
 165         }
 166         else
 167         {
 168             $value = 'LETTER_PART | ' . $value;
 169         }
 170     }
 171
 172     if ($value eq '')
 173     {
 174         $value = '0';
 175     }
 176     else
 177     {
 178         $value = '(' . $value . ')';
 179     }
 180
 181     $map[$code] = $value;
 182 }
 183
 184 sub print_tables
 185 {
 186     my ($last) = @_;
 187
 188     local ($bytes_out) = 0;
 189
 190     open (OUT, "> chartables.h");
 191
 192     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
 193     print OUT "   Instead, edit gen-table.pl and re-run.  */\n\n";
 194
 195     print OUT "#ifndef GCC_CHARTABLES_H\n";
 196     print OUT "#define GCC_CHARTABLES_H\n\n";
 197
 198     print OUT "#define LETTER_START 1\n";
 199     print OUT "#define LETTER_PART  2\n\n";
 200
 201     for ($count = 0; $count <= $last; $count += 256)
 202     {
 203         $row[$count / 256] = &print_row ($count, '(char *) ', 'const char', 1,
 204                                          'page');
 205     }
 206
 207     print OUT "static const char *const type_table[256] = {\n";
 208     for ($count = 0; $count <= $last; $count += 256)
 209     {
 210         print OUT ",\n" if $count > 0;
 211         print OUT "  ", $row[$count / 256];
 212         $bytes_out += 4;
 213     }
 214     print OUT "\n};\n\n";
 215
 216     print OUT "#endif /* ! GCC_CHARTABLES_H */\n";
 217
 218     close (OUT);
 219
 220     printf "Generated %d bytes\n", $bytes_out;
 221 }
 222
 223 # Print a single "row" of a two-level table.
 224 sub print_row
 225 {
 226     my ($start, $def_pfx, $typname, $typsize, $name) = @_;
 227
 228     my ($i);
 229     my (@values);
 230     my ($flag) = 1;
 231     my ($off);
 232     for ($off = 0; $off < 256; ++$off)
 233     {
 234         $values[$off] = $map[$off + $start];
 235         if ($values[$off] ne $values[0])
 236         {
 237             $flag = 0;
 238         }
 239     }
 240     if ($flag)
 241     {
 242         return $def_pfx . $values[0];
 243     }
 244
 245     printf OUT "static %s %s%d[256] = {\n  ", $typname, $name, $start / 256;
 246     my ($column) = 2;
 247     for ($i = $start; $i < $start + 256; ++$i)
 248     {
 249         print OUT ", "
 250             if $i > $start;
 251         my ($text) = $values[$i - $start];
 252         if (length ($text) + $column + 2 > 78)
 253         {
 254             print OUT "\n  ";
 255             $column = 2;
 256         }
 257         print OUT $text;
 258         $column += length ($text) + 2;
 259     }
 260     print OUT "\n};\n\n";
 261
 262     $bytes_out += 256 * $typsize;
 263
 264     return sprintf "%s%d", $name, $start / 256;
 265 }