This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dump.c: format fixes
[perl5.git] / genpacksizetables.pl
index d7dabc7..9dffc2c 100755 (executable)
 use strict;
 use Encode;
 
-my @lines = grep {!/^#/} <DATA>;
+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, $noone, $nocsum, $size) = @_;
-  my $line = "/* $letter */ $size";
-  $line .= " | PACK_SIZE_CANNOT_ONLY_ONE" if $noone;
-  $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
-  $line .= ",";
-  $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;
+sub make_tables {
+    my %arrays;
 
-  my $chrmap = shift;
-  foreach (@_) {
-    my ($letter, $shriek, $noone, $nocsum, $size)
-      = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t(.*)/;
-    die "Can't parse '$_'" unless $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 '$_'";
 
-    unless ($size =~ s/^=//) {
-      $size = "sizeof($size)";
+        $size = "sizeof($size)" unless $size =~ s/^=//;
+
+        $arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} =
+            make_text($chrmap, $letter,
+                      $unpredictable, $nocsum, $size, $condition);
     }
 
-    addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
-            $noone, $nocsum, $size);
-  }
+    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";
+        }
+    }
+    # 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;
+}
 
-  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 = map {$_ || "0,"} @$array;
-    # remove the last, annoying, comma
-    chop $lines[$#lines];
-    print "  $_\n" foreach @lines;
-    print "};\n";
-    $earliest{$arrayname} = $earliest;
-  }
+my @lines = grep {
+    s/#.*//;
+    /\S/;
+} <DATA>;
 
-  print "struct packsize_t packsize[2] = {\n";
+my %asciimap  = map {chr $_, chr $_} 0..255;
+my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
 
-  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";
-}
+print <<"EOC";
+/* These tables are regenerated by genpacksizetables.pl (and then hand pasted
+   in).  You're unlikely ever to need to regenerate them.  */
 
-my %asciimap = (map {chr $_, chr $_} 0..255);
-my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255);
+#if TYPE_IS_SHRIEKING != 0x100
+   ++++shriek offset should be 256
+#endif
 
-print <<'EOC';
+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        nooone  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
 v                      =SIZE16
 n                      =SIZE16
 S                      =SIZE16
-v!                     =SIZE16
-n!                     =SIZE16
+v!                     =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
+n!                     =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
 i                      int
 i!                     int
 I                      unsigned int
@@ -103,14 +110,14 @@ l                 =SIZE32
 L!                     unsigned long
 V                      =SIZE32
 N                      =SIZE32
-V!                     =SIZE32
-N!                     =SIZE32
+V!                     =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
+N!                     =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
 L                      =SIZE32
-p      *       *       char *
-w              *       char
-q                      Quad_t
-Q                      Uquad_t
+p              *       char *
+w      *       *       char
+q                      Quad_t  HAS_QUAD
+Q                      Uquad_t HAS_QUAD
 f                      float
 d                      double
 F                      =NVSIZE
-D                      =LONG_DOUBLESIZE
+D                      =LONG_DOUBLESIZE        HAS_LONG_DOUBLE USE_LONG_DOUBLE