File : genpacksizetables.pl - Ohloh Code Search

Project: Perl

Code Location: git://perl5.git.perl.org/perl.gitmaint-5.12

Download File

genpacksizetables.pl

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
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