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 2987499..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, $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/;
+} <DATA>;
 
-  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