This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlguts: Nit
[perl5.git] / regen / 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
d8a38289 3# it will generate EBCDIC too. (TODO)
78d46eaa
NC
4use strict;
5use Encode;
6b05cb81 6require 'regen/regen_lib.pl';
78d46eaa 7
a7a3cfaa
TH
8sub make_text {
9 my ($chrmap, $letter, $unpredictable, $nocsum, $size, $condition) = @_;
10 my $text = " /* $letter */ $size";
11 $text .= " | PACK_SIZE_UNPREDICTABLE" if $unpredictable;
12 $text .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
13 $text .= ",";
78d46eaa 14
a7a3cfaa
TH
15 if ($condition) {
16 $condition = join " && ", map {"defined($_)"} split ' ', $condition;
17 $text = "#if $condition
18$text
19#else
20 0,
21#endif";
22 }
23 return $text;
78d46eaa
NC
24}
25
a7a3cfaa
TH
26sub make_tables {
27 my %arrays;
78d46eaa 28
a7a3cfaa
TH
29 my $chrmap = shift;
30 foreach (@_) {
31 my ($letter, $shriek, $unpredictable, $nocsum, $size, $condition) =
32 /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/ or
33 die "Can't parse '$_'";
78d46eaa 34
a7a3cfaa 35 $size = "sizeof($size)" unless $size =~ s/^=//;
78d46eaa 36
a7a3cfaa
TH
37 $arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} =
38 make_text($chrmap, $letter,
39 $unpredictable, $nocsum, $size, $condition);
80a13697 40 }
a7a3cfaa 41
f43a9a31 42 my $text = "STATIC const packprops_t packprops[512] = {\n";
a7a3cfaa
TH
43 foreach my $arrayname (qw(normal shrieking)) {
44 my $array = $arrays{$arrayname} ||
45 die "No defined entries in $arrayname";
46 $text .= " /* $arrayname */\n";
47 for my $ch (0..255) {
48 $text .= $array->{$ch} || " 0,";
49 $text .= "\n";
50 }
7212898e 51 }
a7a3cfaa
TH
52 # Join "0," entries together
53 1 while $text =~ s/\b0,\s*\n\s*0,/0, 0,/g;
54 # But split them up again if the sequence gets too long
55 $text =~ s/((?:\b0, ){15}0,) /$1\n /g;
56 # Clean up final ,
57 $text =~ s/,$//;
58 $text .= "};";
59 return $text;
60}
78d46eaa 61
a7a3cfaa
TH
62my @lines = grep {
63 s/#.*//;
64 /\S/;
65} <DATA>;
78d46eaa 66
a7a3cfaa
TH
67my %asciimap = map {chr $_, chr $_} 0..255;
68my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
78d46eaa 69
6b05cb81 70my $fh = open_new('packsizetables.c', '>', { by => $0, from => 'its data'});
78d46eaa 71
6b05cb81 72print $fh <<"EOC";
a7a3cfaa
TH
73#if TYPE_IS_SHRIEKING != 0x100
74 ++++shriek offset should be 256
75#endif
76
77typedef U8 packprops_t;
78d46eaa
NC
78#if 'J'-'I' == 1
79/* ASCII */
a7a3cfaa 80@{[make_tables (\%asciimap, @lines)]}
78d46eaa
NC
81#else
82/* EBCDIC (or bust) */
a7a3cfaa
TH
83@{[make_tables (\%ebcdicmap, @lines)]}
84#endif
78d46eaa 85EOC
78d46eaa 86
6b05cb81
NC
87read_only_bottom_close_and_rename($fh);
88
78d46eaa 89__DATA__
f337b084
TH
90#Symbol unpredictable
91# nocsum size
78d46eaa 92c char
e2add64b 93C unsigned char
f337b084
TH
94W * unsigned char
95U * char
78d46eaa
NC
96s! short
97s =SIZE16
98S! unsigned short
99v =SIZE16
100n =SIZE16
101S =SIZE16
f8e5a5db
NC
102v! =SIZE16
103n! =SIZE16
78d46eaa
NC
104i int
105i! int
106I unsigned int
107I! unsigned int
108j =IVSIZE
109J =UVSIZE
110l! long
111l =SIZE32
112L! unsigned long
113V =SIZE32
114N =SIZE32
f8e5a5db
NC
115V! =SIZE32
116N! =SIZE32
78d46eaa 117L =SIZE32
a72c271b 118p * char *
f337b084 119w * * char
80a13697
NC
120q Quad_t HAS_QUAD
121Q Uquad_t HAS_QUAD
78d46eaa
NC
122f float
123d double
124F =NVSIZE
80a13697 125D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE