This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Minor AUTHORS patch
[perl5.git] / genpacksizetables.pl
... / ...
CommitLineData
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 {
10 my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size,
11 $condition) = @_;
12 my $line = "/* $letter */ $size";
13 $line .= " | PACK_SIZE_SPARE" if $spare;
14 $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
15 $line .= ",";
16 # And then the hack
17 $line = [$condition, $line] if $condition;
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 (@_) {
27 my ($letter, $shriek, $spare, $nocsum, $size, $condition)
28 = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/;
29 die "Can't parse '$_'" unless $size;
30
31 if (defined $condition) {
32 $condition = join " && ", map {"defined($_)"} split ' ', $condition;
33 }
34 unless ($size =~ s/^=//) {
35 $size = "sizeof($size)";
36 }
37
38 addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
39 $spare, $nocsum, $size, $condition);
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";
52 my @lines;
53 foreach (@$array) {
54 # Remove the assumption here that the last entry isn't conditonal
55 if (ref $_) {
56 push @lines,
57 ["#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif"];
58 } else {
59 push @lines, $_ ? " $_" : " 0,";
60 }
61 }
62 # remove the last, annoying, comma
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;
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__
103#Symbol spare nocsum size
104c char
105C unsigned char
106W unsigned char
107U char
108s! short
109s =SIZE16
110S! unsigned short
111v =SIZE16
112n =SIZE16
113S =SIZE16
114v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
115n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
116i int
117i! int
118I unsigned int
119I! unsigned int
120j =IVSIZE
121J =UVSIZE
122l! long
123l =SIZE32
124L! unsigned long
125V =SIZE32
126N =SIZE32
127V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
128N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
129L =SIZE32
130p * char *
131w * char
132q Quad_t HAS_QUAD
133Q Uquad_t HAS_QUAD
134f float
135d double
136F =NVSIZE
137D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE