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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#!/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;
my @lines = grep {!/^#/} <DATA>;
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";
}
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;
if (defined $condition) {
$condition = join " && ", map {"defined($_)"} split ' ', $condition;
}
unless ($size =~ s/^=//) {
$size = "sizeof($size)";
}
addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
$spare, $nocsum, $size, $condition);
}
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,";
}
}
# remove the last, annoying, comma
my $last = $lines[$#lines];
my $got;
foreach (ref $last ? @$last : $last) {
$got += s/,$//;
}
die "Last entry had no commas" unless $got;
print map {"$_\n"} ref $_ ? @$_ : $_ foreach @lines;
print "};\n";
$earliest{$arrayname} = $earliest;
}
print "struct packsize_t packsize[2] = {\n";
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);
print <<'EOC';
#if 'J'-'I' == 1
/* ASCII */
EOC
output_tables (\%asciimap, @lines);
print <<'EOC';
#else
/* EBCDIC (or bust) */
EOC
output_tables (\%ebcdicmap, @lines);
print "#endif\n";
__DATA__
#Symbol spare 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
|
