Commit | Line | Data |
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) |
4 | use strict; |
5 | use Encode; |
6 | |
7 | my @lines = grep {!/^#/} <DATA>; |
8 | |
9 | sub 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 | |
22 | sub 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) { |
7212898e |
54 | # Remove the assumption here that the last entry isn't conditonal |
80a13697 |
55 | if (ref $_) { |
7212898e |
56 | push @lines, |
57 | ["#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif"]; |
80a13697 |
58 | } else { |
59 | push @lines, $_ ? " $_" : " 0,"; |
60 | } |
61 | } |
78d46eaa |
62 | # remove the last, annoying, comma |
7212898e |
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 |
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__ |
103 | #Symbol nooone nocsum size |
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 |
113 | v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN |
114 | n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN |
78d46eaa |
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 |
126 | V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN |
127 | N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN |
78d46eaa |
128 | L =SIZE32 |
129 | p * * char * |
130 | w * char |
80a13697 |
131 | q Quad_t HAS_QUAD |
132 | Q Uquad_t HAS_QUAD |
78d46eaa |
133 | f float |
134 | d double |
135 | F =NVSIZE |
80a13697 |
136 | D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE |