Commit | Line | Data |
---|---|---|
78d46eaa NC |
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) | |
4 | use strict; | |
5 | use Encode; | |
6 | ||
7 | my @lines = grep {!/^#/} <DATA>; | |
8 | ||
9 | sub addline { | |
a72c271b | 10 | my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size, |
80a13697 | 11 | $condition) = @_; |
78d46eaa | 12 | my $line = "/* $letter */ $size"; |
a72c271b | 13 | $line .= " | PACK_SIZE_SPARE" if $spare; |
78d46eaa NC |
14 | $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum; |
15 | $line .= ","; | |
80a13697 NC |
16 | # And then the hack |
17 | $line = [$condition, $line] if $condition; | |
78d46eaa NC |
18 | $arrays->{$arrayname}->[ord $chrmap->{$letter}] = $line; |
19 | # print ord $chrmap->{$letter}, " $line\n"; | |
20 | } | |
21 | ||
22 | sub output_tables { | |
23 | my %arrays; | |
24 | ||
25 | my $chrmap = shift; | |
26 | foreach (@_) { | |
a72c271b | 27 | my ($letter, $shriek, $spare, $nocsum, $size, $condition) |
80a13697 | 28 | = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/; |
78d46eaa NC |
29 | die "Can't parse '$_'" unless $size; |
30 | ||
80a13697 NC |
31 | if (defined $condition) { |
32 | $condition = join " && ", map {"defined($_)"} split ' ', $condition; | |
33 | } | |
78d46eaa NC |
34 | unless ($size =~ s/^=//) { |
35 | $size = "sizeof($size)"; | |
36 | } | |
37 | ||
38 | addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal', | |
a72c271b | 39 | $spare, $nocsum, $size, $condition); |
78d46eaa NC |
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 NC |
52 | my @lines; |
53 | foreach (@$array) { | |
7212898e | 54 | # Remove the assumption here that the last entry isn't conditonal |
80a13697 | 55 | if (ref $_) { |
7212898e NC |
56 | push @lines, |
57 | ["#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif"]; | |
80a13697 NC |
58 | } else { |
59 | push @lines, $_ ? " $_" : " 0,"; | |
60 | } | |
61 | } | |
78d46eaa | 62 | # remove the last, annoying, comma |
7212898e NC |
63 | my $last = $lines[$#lines]; |
64 | my $got; | |
65 | foreach (ref $last ? @$last : $last) { | |
66 | $got += s/,$//; | |
67 | } | |
68 | die "Last entry had no commas" unless $got; | |
69 | print map {"$_\n"} ref $_ ? @$_ : $_ foreach @lines; | |
78d46eaa NC |
70 | print "};\n"; |
71 | $earliest{$arrayname} = $earliest; | |
72 | } | |
73 | ||
74 | print "struct packsize_t packsize[2] = {\n"; | |
75 | ||
76 | my @lines; | |
77 | foreach (qw(normal shrieking)) { | |
78 | my $array = $arrays{$_}; | |
79 | push @lines, " {size_$_, $earliest{$_}, " . (scalar @$array) . "},"; | |
80 | } | |
81 | # remove the last, annoying, comma | |
82 | chop $lines[$#lines]; | |
83 | print "$_\n" foreach @lines; | |
84 | print "};\n"; | |
85 | } | |
86 | ||
87 | my %asciimap = (map {chr $_, chr $_} 0..255); | |
88 | my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255); | |
89 | ||
90 | print <<'EOC'; | |
91 | #if 'J'-'I' == 1 | |
92 | /* ASCII */ | |
93 | EOC | |
94 | output_tables (\%asciimap, @lines); | |
95 | print <<'EOC'; | |
96 | #else | |
97 | /* EBCDIC (or bust) */ | |
98 | EOC | |
99 | output_tables (\%ebcdicmap, @lines); | |
100 | print "#endif\n"; | |
101 | ||
102 | __DATA__ | |
a72c271b | 103 | #Symbol spare nocsum size |
78d46eaa NC |
104 | c char |
105 | C unsigned char | |
106 | U char | |
107 | s! short | |
108 | s =SIZE16 | |
109 | S! unsigned short | |
110 | v =SIZE16 | |
111 | n =SIZE16 | |
112 | S =SIZE16 | |
7212898e NC |
113 | v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN |
114 | n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN | |
78d46eaa NC |
115 | i int |
116 | i! int | |
117 | I unsigned int | |
118 | I! unsigned int | |
119 | j =IVSIZE | |
120 | J =UVSIZE | |
121 | l! long | |
122 | l =SIZE32 | |
123 | L! unsigned long | |
124 | V =SIZE32 | |
125 | N =SIZE32 | |
7212898e NC |
126 | V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN |
127 | N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN | |
78d46eaa | 128 | L =SIZE32 |
a72c271b | 129 | p * char * |
78d46eaa | 130 | w * char |
80a13697 NC |
131 | q Quad_t HAS_QUAD |
132 | Q Uquad_t HAS_QUAD | |
78d46eaa NC |
133 | f float |
134 | d double | |
135 | F =NVSIZE | |
80a13697 | 136 | D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE |