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
  69 # Currently, all things generated by this on EBCDIC are alphabetics, whose
  70 # positions are all the same regardless of code page, so any EBCDIC encoding
  71 # will work; just choose one
  72 my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
  73
  74 my $fh = open_new('packsizetables.c', '>', { by => $0, from => 'its data'});
  75
  76 print $fh <<"EOC";
  77 #if TYPE_IS_SHRIEKING != 0x100
  78    ++++shriek offset should be 256
  79 #endif
  80
  81 typedef U8 packprops_t;
  82 #if 'J'-'I' == 1
  83 /* ASCII */
  84 @{[make_tables (\%asciimap, @lines)]}
  85 #else
  86 /* EBCDIC (or bust) */
  87 @{[make_tables (\%ebcdicmap, @lines)]}
  88 #endif
  89 EOC
  90
  91 read_only_bottom_close_and_rename($fh);
  92
  93 __DATA__
  94 #Symbol unpredictable
  95 #               nocsum  size
  96 c                       char
  97 C                       unsigned char
  98 W       *               unsigned char
  99 U       *               char
 100 s!                      short
 101 s                       =SIZE16
 102 S!                      unsigned short
 103 v                       =SIZE16
 104 n                       =SIZE16
 105 S                       =SIZE16
 106 v!                      =SIZE16
 107 n!                      =SIZE16
 108 i                       int
 109 i!                      int
 110 I                       unsigned int
 111 I!                      unsigned int
 112 j                       =IVSIZE
 113 J                       =UVSIZE
 114 l!                      long
 115 l                       =SIZE32
 116 L!                      unsigned long
 117 V                       =SIZE32
 118 N                       =SIZE32
 119 V!                      =SIZE32
 120 N!                      =SIZE32
 121 L                       =SIZE32
 122 p               *       char *
 123 w       *       *       char
 124 q                       Quad_t  HAS_QUAD
 125 Q                       Uquad_t HAS_QUAD
 126 f                       float
 127 d                       double
 128 F                       =NVSIZE
 129 D                       =LONG_DOUBLESIZE        HAS_LONG_DOUBLE USE_LONG_DOUBLE