/[classpath]/classpath/doc/unicode/unicode-muncher.pl
ViewVC logotype

Diff of /classpath/doc/unicode/unicode-muncher.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by rao, Sun Aug 9 23:18:28 1998 UTC revision 1.2 by ericb, Sun Feb 17 07:30:03 2002 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    # unicode-muncher -- Script to generate Unicode data for java.lang.Character
3    # Copyright (C) 1998, 2002 Free Software Foundation, Inc.
4    #
5    # This file is part of GNU Classpath.
6    #
7    # GNU Classpath 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    # GNU Classpath is distributed in the hope that it will be useful, but
13    # WITHOUT ANY WARRANTY; without even the implied warranty of
14    # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15    # General Public License for more details.
16    #
17    # You should have received a copy of the GNU General Public License
18    # along with GNU Classpath; see the file COPYING.  If not, write to the
19    # Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20    # 02111-1307 USA.
21    #
22    # Linking this library statically or dynamically with other modules is
23    # making a combined work based on this library.  Thus, the terms and
24    # conditions of the GNU General Public License cover the whole
25    # combination.
26    #
27    # As a special exception, the copyright holders of this library give you
28    # permission to link this library with independent modules to produce an
29    # executable, regardless of the license terms of these independent
30    # modules, and to copy and distribute the resulting executable under
31    # terms of your choice, provided that you also meet, for each linked
32    # independent module, the terms and conditions of the license of that
33    # module.  An independent module is a module which is not derived from
34    # or based on this library.  If you modify this library, you may extend
35    # this exception to your version of the library, but you are not
36    # obligated to do so.  If you do not wish to do so, delete this
37    # exception statement from your version.
38    
39    
40  # This is lots of really ugly hacked up Perl code.  # This is lots of really ugly hacked up Perl code.
41  # It works.  Don't touch it, or it'll break.  # It works.  Don't touch it, or it'll break.
42  # I'm far from proud of it.  If you want to fix it so it  # I'm far from proud of it.  If you want to fix it so it
# Line 6  Line 44 
44  # See unicode.database.format for information on the files  # See unicode.database.format for information on the files
45  # this program generates.  # this program generates.
46    
47  # usage: unicode-muncher.pl UnicodeData-2.1.2.txt  # usage: unicode-muncher.pl UnicodeData-3.0.0.txt
   
 # Code for reading BLOCKS.TXT and generating stubs for Character.Subset  
 #  
 #  open (BLOCKS, $ARGV[1]) || die "Can't open Unicode block file: $!\n";  
 #  &read_block;  
 #  
 #  sub read_block {  
 #      ($start, $end, $block) = split(/; /, <BLOCKS>);  
 #      chop $block; chop $block;  
 #      if ($start =~ /#./) {  
 #       &read_block;  
 #      } else {  
 #       $curr_block++;  
 #  
 #  # Generate Character.Subset information        
 #  #    $block =~ tr/a-z/A-Z/;  
 #  #    $block =~ y/ ,-/_/;  
 #  #    print "$block = new Subset('\\u$start', '\\u$end'),\n";  
 #  
 #       $start = hex($start);  
 #       $end   = hex($end);  
 #  
 #      };  
 #  }  
48    
49  sub write_char {  sub write_char {
50      $S = $jnobreakspace << 5;      my $wnum = ($jnum < 65534) ? $hex - $jnum : $jnum;
51      print CHAR      $buf = pack ("Cn3c", ($jmirrored << 6) | ($jnobreakspace << 5) | $cat,
52        (pack ("C", $S | $cat));                   $wnum, $jupper, $jlower, $jdir);
53      print CHAR (pack ("n", $jnum));      print CHAR $buf;
54      print CHAR (pack ("n", $jupper));      if (! defined $hash{$buf}) {
55      print CHAR (pack ("n", $jlower));          $hash{$buf} = $offset;
56        }
57        $offset += 8;
58  }  }
59    
60  sub end_block {  sub end_block {
61        my $joffset;
62      print BLOCK (pack ("n", $start));      print BLOCK (pack ("n", $start));
63      print BLOCK (pack ("n", $lhex));      print BLOCK (pack ("n", $lhex));
64      $comp = 0 if ($comp != 1);      $characters += $lhex - $start + 1;
65      print BLOCK (pack ("C", $comp));      $blocks++;
     print BLOCK (pack ("N", $offset));  
66    
67      # calculate next offset      # calculate next offset
68      if ($comp == 1) {      if ($comp == 1) {
69          $offset += 7;          $joffset = $hash{$buf};
70      } else {          if ($joffset + 8 < $offset) { # Reuse a previous attribute
71          $offset += (7 * ($lhex - $start + 1));              $offset -= 8;
72                seek CHAR, $offset, SEEK_SET;
73            }
74        } else {
75            $joffset = $offset - 8 * ($lhex - $start + 1);
76            $comp = 0; # Create a string of uncompressed attributes
77      }      }
78        die "sanity: offset out of range!\n" if ($joffset >= 32768);
79        print BLOCK (pack ("n", ($comp << 15) | $joffset));
80    
81      # setup next starting block      # setup next starting block
82      $start = $hex;      $start = $hex;
83      # default to unknown compression      # default to unknown compression
# Line 63  sub end_block { Line 87  sub end_block {
87  open (DATA, $ARGV[0]) || die "Can't open Unicode attribute file: $!\n";  open (DATA, $ARGV[0]) || die "Can't open Unicode attribute file: $!\n";
88    
89  open (TITLECASE, ">titlecase.uni") || die ("Can't open titlecase file: $!\n");  open (TITLECASE, ">titlecase.uni") || die ("Can't open titlecase file: $!\n");
90    binmode TITLECASE;
91  open (CHAR, ">character.uni") || die ("Can't open character file: $!\n");  open (CHAR, ">character.uni") || die ("Can't open character file: $!\n");
92    binmode CHAR;
93  open (BLOCK, ">block.uni") || die ("Can't open block file: $!\n");  open (BLOCK, ">block.uni") || die ("Can't open block file: $!\n");
94    binmode BLOCK;
95    
96  $| = 1;  $| = 1;
97  print "GNU Classpath Unicode Attribute Database Generator 1.0\n";  print "GNU Classpath Unicode Attribute Database Generator 1.1\n";
98  print "Copyright (C) 1998, Free Software Foundation, Inc.\n";  print "Copyright (C) 1998, 2002 Free Software Foundation, Inc.\n";
99  print "Creating";  print "Creating";
100    
101  $offset = 0;  $offset = 0;
102  $hex = -1;  $hex = -1;
103    $buf = "";
104    $characters = 0;
105    $blocks = 0;
106    $ignored = 0;
107  while (<DATA>) {  while (<DATA>) {
108      $llhex = $lhex;      $llhex = $lhex;
109      $lhex = $hex;      $lhex = $hex;
# Line 84  while (<DATA>) { Line 115  while (<DATA>) {
115                    
116      # convert unicode index strings to hex      # convert unicode index strings to hex
117      $hex = hex($hex);      $hex = hex($hex);
118        if ($hex > 0xffff) { # Ignore surrogates, since Java does
119            $ignored++;
120            $lhex = $llhex;
121            $hex = $lhex;
122            next;
123        }
124      $upcase = hex($upcase);      $upcase = hex($upcase);
125      $lowcase = hex($lowcase);      $lowcase = hex($lowcase);
126      $titlecase = hex($titlecase);      $titlecase = hex($titlecase);
127    
 # read blocks - code used only when counting absolute blocks  
 #    print "end of block\n" if (($lhex+1) != $hex);  
 #     # read blocks until we find a valid range  
 #    while ($hex > $end) {  
 #       &read_block;  
 #    }  
 #    # $curr_block now contains the correct block  
   
 # handle isIdentifierIgnorable()  
 # this is according to the javadoc spec, which is broken.  
 #    $jidentignore =  ($category =~ /(Cf)|(Cc)/ &&  
 #                     !($unicode1n =~ /SEPARATOR|RETURN|TAB|FEED/)) ? 1 : 0;  
   
128      $jnobreakspace = ($category eq "Zs" && $decomp =~ /noBreak/) ? 1 : 0;      $jnobreakspace = ($category eq "Zs" && $decomp =~ /noBreak/) ? 1 : 0;
129    
130      # handle getNumericValue()      # handle getNumericValue(). $jnum is either -1 for no value, -2 for
131        # non-positive integer value, or the offset of the value from $hex
132      if ($numeric eq "") {      if ($numeric eq "") {
133          $jnum = 65535;          # does not have a numeric value          $jnum = 65535;          # does not have a numeric value
134            # Special case sequences of 'a'-'z'
135            if ($hex >= 0x0041 && $hex <= 0x005a) {
136                $jnum = 0x0037;
137            } elsif ($hex >= 0x0061 && $hex <= 0x007a) {
138                $jnum = 0x0057;
139            } elsif ($hex >= 0xff21 && $hex <= 0xff3a) {
140                $jnum = 0xff17;
141            } elsif ($hex >= 0xff41 && $hex <= 0xff5a) {
142                $jnum = 0xff37;
143            }
144      } else {      } else {
145          if ($numeric =~ /^[0-9]+$/) {          if ($numeric =~ /^[0-9]+$/) {
146              $jnum = $numeric;   # nonnegative integer value              $jnum = $hex - $numeric;    # nonnegative integer value
147              die "sanity: numeric out of range!\n" if ($jnum >= 65534);              die "sanity: numeric out of range!\n" if ($jnum >= 65534 ||
148          } else {                                                        $jnum <= -65534);
149            } else {
150              $jnum = 65534;      # other integer value              $jnum = 65534;      # other integer value
151          }          }
152      }      }
153    
154      # handle uppercase mapping      # handle uppercase mapping - use the offset from $hex
155      $jupper = $upcase;      $jupper = ($upcase == 0) ? 0 : ($hex - $upcase);
156    
157      # handle lowercase mapping      # handle lowercase mapping - use the offset from $hex
158      $jlower = $lowcase;      $jlower = ($lowcase == 0) ? 0 : ($hex - $lowcase);
159    
160      # handle titlecase mapping - go ahead and output to file      # handle titlecase mapping - go ahead and output to file
161      if ($titlecase != $upcase && $titlecase != 0 && $upcase != 0) {      if ($titlecase != $upcase) {
162            $titlecase = $hex if ($titlecase == 0);
163          print TITLECASE (pack ("n2", $hex, $titlecase));          print TITLECASE (pack ("n2", $hex, $titlecase));
164      }      }
165    
# Line 158  while (<DATA>) { Line 195  while (<DATA>) {
195          if (/Sc/) { $cat = 26; last CAT; } # symbol, currency          if (/Sc/) { $cat = 26; last CAT; } # symbol, currency
196          if (/Sk/) { $cat = 27; last CAT; } # symbol, modifier          if (/Sk/) { $cat = 27; last CAT; } # symbol, modifier
197          if (/So/) { $cat = 28; last CAT; } # symbol, other          if (/So/) { $cat = 28; last CAT; } # symbol, other
198            if (/Pi/) { $cat = 29; last CAT; } # punctuation, initial quote
199            if (/Pf/) { $cat = 30; last CAT; } # punctuation, final quote
200            $cat = 0; # unassigned
201        }
202    
203        # handle mirrored characters
204        $jmirrored = ($mirrored eq "Y") ? 1 : 0;
205    
206        # handle directionality
207        $_ = $bidir;
208        BIDIR: {
209            if (/^L$/) { $jdir = 0; last BIDIR; } # Left-to-Right
210            if (/^R$/) { $jdir = 1; last BIDIR; } # Right-to-Left
211            if (/^AL$/) { $jdir = 2; last BIDIR; } # Right-to-Left Arabic
212            if (/^EN$/) { $jdir = 3; last BIDIR; } # European Number
213            if (/^ES$/) { $jdir = 4; last BIDIR; } # European Numer Separator
214            if (/^ET$/) { $jdir = 5; last BIDIR; } # European Numer Terminator
215            if (/^AN$/) { $jdir = 6; last BIDIR; } # Arabic Number
216            if (/^CS$/) { $jdir = 7; last BIDIR; } # Common Number Separator
217            if (/^NSM$/) { $jdir = 8; last BIDIR; } # Non-Spacing Mark
218            if (/^BN$/) { $jdir = 9; last BIDIR; } # Boundary Neutral
219            if (/^B$/) { $jdir = 10; last BIDIR; } # Paragraph Separator
220            if (/^S$/) { $jdir = 11; last BIDIR; } # Segment Separator
221            if (/^WS$/) { $jdir = 12; last BIDIR; } # Whitespace
222            if (/^ON$/) { $jdir = 13; last BIDIR; } # Other Neutral
223            if (/^LRE$/) { $jdir = 14; last BIDIR; } # Left-to-Right Embedding
224            if (/^LRO$/) { $jdir = 15; last BIDIR; } # Left-to-Right Override
225            if (/^RLE$/) { $jdir = 16; last BIDIR; } # Right-to-Left Embedding
226            if (/^RLO$/) { $jdir = 17; last BIDIR; } # Right-to-Left Override
227            if (/^PDF$/) { $jdir = 18; last BIDIR; } # Pop Directional Format
228            $jdir = -1; # undefined
229      }      }
230    
231    CHAR: {    CHAR: {
232        # starting point        # starting point
233        if ($hex == 0) {        if ($hex == 0) {
234            &write_char;            &write_char;
235            $comp = 2;            # compressed block state unknown until next ch            $comp = 2;            # compressed block state unknown until next ch
236            $start = 0;            $start = 0;
237            $offset = 0;            last CHAR;
           last CHAR;  
238        }        }
239    
240        # handle mandatory blocks        # handle mandatory blocks
# Line 185  while (<DATA>) { Line 252  while (<DATA>) {
252        }        }
253    
254        # not sequential, end block.        # not sequential, end block.
255        if (($lhex+1) != $hex) {        if (($lhex+1) != $hex) {
256            &end_block;            &end_block;
257            &write_char;            &write_char;
258            last CHAR;            last CHAR;
259        }        }
260    
261        # check to see if we can compress this character into the current block        # check to see if we can compress this character into the current block
# Line 196  while (<DATA>) { Line 263  while (<DATA>) {
263            $jnum == $ljnum &&            $jnum == $ljnum &&
264            $jnobreakspace == $ljnobreakspace &&            $jnobreakspace == $ljnobreakspace &&
265            $jupper == $ljupper &&            $jupper == $ljupper &&
266            $jlower == $ljlower) {            $jlower == $ljlower &&
267              $jmirrored == $ljmirrored &&
268              $jdir == $ljdir) {
269            if ($comp == 2) { $comp = 1; } # start compressing            if ($comp == 2) { $comp = 1; } # start compressing
270            # end uncompressed block            # end uncompressed block
271            if ($comp == 0) {            if ($comp == 0) {
272                $tmp = $lhex;                $tmp = $lhex;
273                $lhex = $llhex;                $lhex = $llhex;
274                  $offset -= 8;
275                &end_block;                &end_block;
276                $start = $lhex = $tmp;                $start = $lhex = $tmp;
277                $comp = 1;                $offset += 8;
278                  $comp = 1;
279            }            }
280        } else {        } else {
281            if ($comp == 2) { $comp = 0; };            if ($comp == 2) { $comp = 0; };
282            if ($comp == 1) { &end_block; $comp = 2; }            if ($comp == 1) { &end_block; }
283            &write_char;            &write_char;
284        }        }
285    }    }
# Line 219  while (<DATA>) { Line 290  while (<DATA>) {
290      $ljnobreakspace = $jnobreakspace;      $ljnobreakspace = $jnobreakspace;
291      $ljupper = $jupper;      $ljupper = $jupper;
292      $ljlower = $jlower;      $ljlower = $jlower;
293        $ljmirrored = $jmirrored;
294        $ljdir = $jdir;
295  }  }
296  $lhex = $hex;                   # setup final block write  $lhex = $hex;                   # setup final block write
297  &end_block;                     # write final block  &end_block;                     # write final block
298    truncate CHAR, $offset + 8;     # remove final duplicate record, if it exists
299    
300  close(DATA);  close(DATA);
301  close(TITLECASE);  close(TITLECASE);
# Line 229  close(CHAR); Line 303  close(CHAR);
303  close(BLOCK);  close(BLOCK);
304    
305  print "ok\n";  print "ok\n";
306    print "Created " . ($offset + 8)/8 . " attributes for $characters "
307  # Second step of compression -- elimate duplicate compressed blocks      . "Unicode characters in $blocks blocks.\n"
308  # in char.uni.  Should save about 2k; might implement later.      . "(Ignored $ignored surrogates.)\n";
 #  
 #  open (DATA, "<block.uni") || die ("Can't open block file: $!\n");  
 #  open (CHAR, "<character.uni") || die ("Can't open char file: $!\n");  
 #  $offset = 0;  
 #  $comp = 0;  
 #  while (read DATA, $buf, 9) {  
 #      ($start, $end, $comp, $off) = unpack("nnCN", $buf);  
 #      if ($comp == 1) {  
 #       seek CHAR, $off, 0;  
 #       read CHAR, $cbuf, 7;  
 #       push @$cbuf, $off;  
 #       $arrays{$cbuf} = $cbuf;  
 #      }  
 #  }  

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26