Shrink a switch() statment by driving the size calculations from the
[p5sagit/p5-mst-13.2.git] / genpacksizetables.pl
CommitLineData
78d46eaa 1#!/usr/bin/perl -w
2# I'm assuming that you're running this on some kind of ASCII system, but
3# it will generate EDCDIC too. (TODO)
4use strict;
5use Encode;
6
7my @lines = grep {!/^#/} <DATA>;
8
9sub addline {
80a13697 10 my ($arrays, $chrmap, $letter, $arrayname, $noone, $nocsum, $size,
11 $condition) = @_;
78d46eaa 12 my $line = "/* $letter */ $size";
13 $line .= " | PACK_SIZE_CANNOT_ONLY_ONE" if $noone;
14 $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
15 $line .= ",";
80a13697 16 # And then the hack
17 $line = [$condition, $line] if $condition;
78d46eaa 18 $arrays->{$arrayname}->[ord $chrmap->{$letter}] = $line;
19 # print ord $chrmap->{$letter}, " $line\n";
20}
21
22sub output_tables {
23 my %arrays;
24
25 my $chrmap = shift;
26 foreach (@_) {
80a13697 27 my ($letter, $shriek, $noone, $nocsum, $size, $condition)
28 = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/;
78d46eaa 29 die "Can't parse '$_'" unless $size;
30
80a13697 31 if (defined $condition) {
32 $condition = join " && ", map {"defined($_)"} split ' ', $condition;
33 }
78d46eaa 34 unless ($size =~ s/^=//) {
35 $size = "sizeof($size)";
36 }
37
38 addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
80a13697 39 $noone, $nocsum, $size, $condition);
78d46eaa 40 }
41
42 my %earliest;
43 foreach my $arrayname (sort keys %arrays) {
44 my $array = $arrays{$arrayname};
45 die "No defined entries in $arrayname" unless $array->[$#$array];
46 # Find the first used entry
47 my $earliest = 0;
48 $earliest++ while (!$array->[$earliest]);
49 # Remove all the empty elements.
50 splice @$array, 0, $earliest;
51 print "unsigned char size_${arrayname}[", scalar @$array, "] = {\n";
80a13697 52 my @lines;
53 foreach (@$array) {
54 # There is an assumption here that the last entry isn't conditonal
55 if (ref $_) {
56 push @lines, "#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif";
57 } else {
58 push @lines, $_ ? " $_" : " 0,";
59 }
60 }
78d46eaa 61 # remove the last, annoying, comma
80a13697 62 die "Last entry was a conditional: '$lines[$#lines]'"
63 unless $lines[$#lines] =~ s/,$//;
64 print "$_\n" foreach @lines;
78d46eaa 65 print "};\n";
66 $earliest{$arrayname} = $earliest;
67 }
68
69 print "struct packsize_t packsize[2] = {\n";
70
71 my @lines;
72 foreach (qw(normal shrieking)) {
73 my $array = $arrays{$_};
74 push @lines, " {size_$_, $earliest{$_}, " . (scalar @$array) . "},";
75 }
76 # remove the last, annoying, comma
77 chop $lines[$#lines];
78 print "$_\n" foreach @lines;
79 print "};\n";
80}
81
82my %asciimap = (map {chr $_, chr $_} 0..255);
83my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255);
84
85print <<'EOC';
86#if 'J'-'I' == 1
87/* ASCII */
88EOC
89output_tables (\%asciimap, @lines);
90print <<'EOC';
91#else
92/* EBCDIC (or bust) */
93EOC
94output_tables (\%ebcdicmap, @lines);
95print "#endif\n";
96
97__DATA__
98#Symbol nooone nocsum size
99c char
100C unsigned char
101U char
102s! short
103s =SIZE16
104S! unsigned short
105v =SIZE16
106n =SIZE16
107S =SIZE16
108v! =SIZE16
109n! =SIZE16
110i int
111i! int
112I unsigned int
113I! unsigned int
114j =IVSIZE
115J =UVSIZE
116l! long
117l =SIZE32
118L! unsigned long
119V =SIZE32
120N =SIZE32
121V! =SIZE32
122N! =SIZE32
123L =SIZE32
124p * * char *
125w * char
80a13697 126q Quad_t HAS_QUAD
127Q Uquad_t HAS_QUAD
78d46eaa 128f float
129d double
130F =NVSIZE
80a13697 131D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE