Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: GitLive-maint-…
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 124 lines (110 sloc) 2.99 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
#!/usr/bin/perl -w
# I'm assuming that you're running this on some kind of ASCII system, but
# it will generate EDCDIC too. (TODO)
use strict;
use Encode;

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 .= ",";

    if ($condition) {
        $condition = join " && ", map {"defined($_)"} split ' ', $condition;
        $text = "#if $condition
$text
#else
0,
#endif";
    }
    return $text;
}

sub make_tables {
    my %arrays;

    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 '$_'";

        $size = "sizeof($size)" unless $size =~ s/^=//;

        $arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} =
            make_text($chrmap, $letter,
                      $unpredictable, $nocsum, $size, $condition);
    }

    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 @lines = grep {
    s/#.*//;
    /\S/;
} <DATA>;

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. */

#if TYPE_IS_SHRIEKING != 0x100
++++shriek offset should be 256
#endif

typedef U8 packprops_t;
#if 'J'-'I' == 1
/* ASCII */
@{[make_tables (\%asciimap, @lines)]}
#else
/* EBCDIC (or bust) */
@{[make_tables (\%ebcdicmap, @lines)]}
#endif
EOC

__DATA__
#Symbol unpredictable
# nocsum size
c char
C * unsigned char
W * unsigned char PERL_PACK_CAN_W
U * char
s! short
s =SIZE16
S! unsigned short
v =SIZE16
n =SIZE16
S =SIZE16
v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN
i int
i! int
I unsigned int
I! unsigned int
j =IVSIZE
J =UVSIZE
l! long
l =SIZE32
L! unsigned long
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 HAS_QUAD
Q Uquad_t HAS_QUAD
f float
d double
F =NVSIZE
D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE
Something went wrong with that request. Please try again.