This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
6d70cad3d590c9639b67838bf5f2443024ef3ec4
[perl5.git] / regen / genpacksizetables.pl
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 EBCDIC too. (TODO)
4 use strict;
5 use Encode;
6 require 'regen/regen_lib.pl';
7
8 sub 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 .= ",";
14
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;
24 }
25
26 sub make_tables {
27     my %arrays;
28
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 '$_'";
34
35         $size = "sizeof($size)" unless $size =~ s/^=//;
36
37         $arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} =
38             make_text($chrmap, $letter,
39                       $unpredictable, $nocsum, $size, $condition);
40     }
41
42     my $text = "STATIC const packprops_t packprops[512] = {\n";
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         }
51     }
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 }
61
62 my @lines = grep {
63     s/#.*//;
64     /\S/;
65 } <DATA>;
66
67 my %asciimap  = map {chr $_, chr $_} 0..255;
68 my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
69
70 my $fh = open_new('packsizetables.c', '>', { by => $0, from => 'its data'});
71
72 print $fh <<"EOC";
73 #if TYPE_IS_SHRIEKING != 0x100
74    ++++shriek offset should be 256
75 #endif
76
77 typedef U8 packprops_t;
78 #if 'J'-'I' == 1
79 /* ASCII */
80 @{[make_tables (\%asciimap, @lines)]}
81 #else
82 /* EBCDIC (or bust) */
83 @{[make_tables (\%ebcdicmap, @lines)]}
84 #endif
85 EOC
86
87 read_only_bottom_close_and_rename($fh);
88
89 __DATA__
90 #Symbol unpredictable
91 #               nocsum  size
92 c                       char
93 C                       unsigned char
94 W       *               unsigned char
95 U       *               char
96 s!                      short
97 s                       =SIZE16
98 S!                      unsigned short
99 v                       =SIZE16
100 n                       =SIZE16
101 S                       =SIZE16
102 v!                      =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
103 n!                      =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
104 i                       int
105 i!                      int
106 I                       unsigned int
107 I!                      unsigned int
108 j                       =IVSIZE
109 J                       =UVSIZE
110 l!                      long
111 l                       =SIZE32
112 L!                      unsigned long
113 V                       =SIZE32
114 N                       =SIZE32
115 V!                      =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
116 N!                      =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
117 L                       =SIZE32
118 p               *       char *
119 w       *       *       char
120 q                       Quad_t  HAS_QUAD
121 Q                       Uquad_t HAS_QUAD
122 f                       float
123 d                       double
124 F                       =NVSIZE
125 D                       =LONG_DOUBLESIZE        HAS_LONG_DOUBLE USE_LONG_DOUBLE