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