perl/genpacksizetables.pl
<<
>>
Prefs
   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 EDCDIC too. (TODO)
   4use strict;
   5use Encode;
   6
   7sub make_text {
   8    my ($chrmap, $letter, $unpredictable, $nocsum, $size, $condition) = @_;
   9    my $text = "    /* $letter */ $size";
  10    $text .= " | PACK_SIZE_UNPREDICTABLE" if $unpredictable;
  11    $text .= " | PACK_SIZE_CANNOT_CSUM"   if $nocsum;
  12    $text .= ",";
  13
  14    if ($condition) {
  15        $condition = join " && ", map {"defined($_)"} split ' ', $condition;
  16        $text = "#if $condition
  17$text
  18#else
  19    0,
  20#endif";
  21    }
  22    return $text;
  23}
  24
  25sub 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
  61my @lines = grep {
  62    s/#.*//;
  63    /\S/;
  64} <DATA>;
  65
  66my %asciimap  = map {chr $_, chr $_} 0..255;
  67my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
  68
  69print <<"EOC";
  70/* These tables are regenerated by genpacksizetables.pl (and then hand pasted
  71   in).  You're unlikely ever to need to regenerate them.  */
  72
  73#if TYPE_IS_SHRIEKING != 0x100
  74   ++++shriek offset should be 256
  75#endif
  76
  77typedef 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
  85EOC
  86
  87__DATA__
  88#Symbol unpredictable
  89#               nocsum  size
  90c                       char
  91C       *               unsigned char
  92W       *               unsigned char
  93U       *               char
  94s!                      short
  95s                       =SIZE16
  96S!                      unsigned short
  97v                       =SIZE16
  98n                       =SIZE16
  99S                       =SIZE16
 100v!                      =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
 101n!                      =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
 102i                       int
 103i!                      int
 104I                       unsigned int
 105I!                      unsigned int
 106j                       =IVSIZE
 107J                       =UVSIZE
 108l!                      long
 109l                       =SIZE32
 110L!                      unsigned long
 111V                       =SIZE32
 112N                       =SIZE32
 113V!                      =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
 114N!                      =SIZE32 PERL_PACK_CAN_SHRIEKSIGN
 115L                       =SIZE32
 116p               *       char *
 117w       *       *       char
 118q                       Quad_t  HAS_QUAD
 119Q                       Uquad_t HAS_QUAD
 120f                       float
 121d                       double
 122F                       =NVSIZE
 123D                       =LONG_DOUBLESIZE        HAS_LONG_DOUBLE USE_LONG_DOUBLE
 124
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.