This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regenerate Perl_keyword() to remove superfluous goto statements.
[perl5.git] / genpacksizetables.pl
CommitLineData
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)
4use strict;
5use Encode;
6
7my @lines = grep {!/^#/} <DATA>;
8
9sub 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
22sub 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
87my %asciimap = (map {chr $_, chr $_} 0..255);
88my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255);
89
90print <<'EOC';
91#if 'J'-'I' == 1
92/* ASCII */
93EOC
94output_tables (\%asciimap, @lines);
95print <<'EOC';
96#else
97/* EBCDIC (or bust) */
98EOC
99output_tables (\%ebcdicmap, @lines);
100print "#endif\n";
101
102__DATA__
a72c271b 103#Symbol spare nocsum size
78d46eaa
NC
104c char
105C unsigned char
106U char
107s! short
108s =SIZE16
109S! unsigned short
110v =SIZE16
111n =SIZE16
112S =SIZE16
7212898e
NC
113v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
114n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
78d46eaa
NC
115i int
116i! int
117I unsigned int
118I! unsigned int
119j =IVSIZE
120J =UVSIZE
121l! long
122l =SIZE32
123L! unsigned long
124V =SIZE32
125N =SIZE32
7212898e
NC
126V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
127N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
78d46eaa 128L =SIZE32
a72c271b 129p * char *
78d46eaa 130w * char
80a13697
NC
131q Quad_t HAS_QUAD
132Q Uquad_t HAS_QUAD
78d46eaa
NC
133f float
134d double
135F =NVSIZE
80a13697 136D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE