X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a72c271bac70ecc52cda8ed4ba689c8816509735..5d1df013f129444120d386e5cf0d006a9a4e8f0c:/genpacksizetables.pl diff --git a/genpacksizetables.pl b/genpacksizetables.pl old mode 100755 new mode 100644 index 2987499..9dffc2c --- a/genpacksizetables.pl +++ b/genpacksizetables.pl @@ -4,106 +4,93 @@ use strict; use Encode; -my @lines = grep {!/^#/} ; +sub make_text { + my ($chrmap, $letter, $unpredictable, $nocsum, $size, $condition) = @_; + my $text = " /* $letter */ $size"; + $text .= " | PACK_SIZE_UNPREDICTABLE" if $unpredictable; + $text .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum; + $text .= ","; -sub addline { - my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size, - $condition) = @_; - my $line = "/* $letter */ $size"; - $line .= " | PACK_SIZE_SPARE" if $spare; - $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum; - $line .= ","; - # And then the hack - $line = [$condition, $line] if $condition; - $arrays->{$arrayname}->[ord $chrmap->{$letter}] = $line; - # print ord $chrmap->{$letter}, " $line\n"; + if ($condition) { + $condition = join " && ", map {"defined($_)"} split ' ', $condition; + $text = "#if $condition +$text +#else + 0, +#endif"; + } + return $text; } -sub output_tables { - my %arrays; - - my $chrmap = shift; - foreach (@_) { - my ($letter, $shriek, $spare, $nocsum, $size, $condition) - = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/; - die "Can't parse '$_'" unless $size; +sub make_tables { + my %arrays; - if (defined $condition) { - $condition = join " && ", map {"defined($_)"} split ' ', $condition; - } - unless ($size =~ s/^=//) { - $size = "sizeof($size)"; - } + my $chrmap = shift; + foreach (@_) { + my ($letter, $shriek, $unpredictable, $nocsum, $size, $condition) = + /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/ or + die "Can't parse '$_'"; - addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal', - $spare, $nocsum, $size, $condition); - } + $size = "sizeof($size)" unless $size =~ s/^=//; - my %earliest; - foreach my $arrayname (sort keys %arrays) { - my $array = $arrays{$arrayname}; - die "No defined entries in $arrayname" unless $array->[$#$array]; - # Find the first used entry - my $earliest = 0; - $earliest++ while (!$array->[$earliest]); - # Remove all the empty elements. - splice @$array, 0, $earliest; - print "unsigned char size_${arrayname}[", scalar @$array, "] = {\n"; - my @lines; - foreach (@$array) { - # Remove the assumption here that the last entry isn't conditonal - if (ref $_) { - push @lines, - ["#if $_->[0]", " $_->[1]", "#else", " 0,", "#endif"]; - } else { - push @lines, $_ ? " $_" : " 0,"; - } + $arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} = + make_text($chrmap, $letter, + $unpredictable, $nocsum, $size, $condition); } - # remove the last, annoying, comma - my $last = $lines[$#lines]; - my $got; - foreach (ref $last ? @$last : $last) { - $got += s/,$//; + + my $text = "STATIC const packprops_t packprops[512] = {\n"; + foreach my $arrayname (qw(normal shrieking)) { + my $array = $arrays{$arrayname} || + die "No defined entries in $arrayname"; + $text .= " /* $arrayname */\n"; + for my $ch (0..255) { + $text .= $array->{$ch} || " 0,"; + $text .= "\n"; + } } - die "Last entry had no commas" unless $got; - print map {"$_\n"} ref $_ ? @$_ : $_ foreach @lines; - print "};\n"; - $earliest{$arrayname} = $earliest; - } + # Join "0," entries together + 1 while $text =~ s/\b0,\s*\n\s*0,/0, 0,/g; + # But split them up again if the sequence gets too long + $text =~ s/((?:\b0, ){15}0,) /$1\n /g; + # Clean up final , + $text =~ s/,$//; + $text .= "};"; + return $text; +} - print "struct packsize_t packsize[2] = {\n"; +my @lines = grep { + s/#.*//; + /\S/; +} ; - my @lines; - foreach (qw(normal shrieking)) { - my $array = $arrays{$_}; - push @lines, " {size_$_, $earliest{$_}, " . (scalar @$array) . "},"; - } - # remove the last, annoying, comma - chop $lines[$#lines]; - print "$_\n" foreach @lines; - print "};\n"; -} +my %asciimap = map {chr $_, chr $_} 0..255; +my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255; -my %asciimap = (map {chr $_, chr $_} 0..255); -my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255); +print <<"EOC"; +/* These tables are regenerated by genpacksizetables.pl (and then hand pasted + in). You're unlikely ever to need to regenerate them. */ -print <<'EOC'; +#if TYPE_IS_SHRIEKING != 0x100 + ++++shriek offset should be 256 +#endif + +typedef U8 packprops_t; #if 'J'-'I' == 1 /* ASCII */ -EOC -output_tables (\%asciimap, @lines); -print <<'EOC'; +@{[make_tables (\%asciimap, @lines)]} #else /* EBCDIC (or bust) */ +@{[make_tables (\%ebcdicmap, @lines)]} +#endif EOC -output_tables (\%ebcdicmap, @lines); -print "#endif\n"; __DATA__ -#Symbol spare nocsum size +#Symbol unpredictable +# nocsum size c char -C unsigned char -U char +C * unsigned char +W * unsigned char +U * char s! short s =SIZE16 S! unsigned short @@ -127,7 +114,7 @@ V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN L =SIZE32 p * char * -w * char +w * * char q Quad_t HAS_QUAD Q Uquad_t HAS_QUAD f float