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