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
7my @lines = grep {!/^#/} <DATA>;
8
9sub addline {
10  my ($arrays, $chrmap, $letter, $arrayname, $spare, $nocsum, $size,
11      $condition) = @_;
12  my $line = "/* $letter */ $size";
13  $line .= " | PACK_SIZE_SPARE" if $spare;
14  $line .= " | PACK_SIZE_CANNOT_CSUM" if $nocsum;
15  $line .= ",";
16  # And then the hack
17  $line = [$condition, $line] if $condition;
18  $arrays->{$arrayname}->[ord $chrmap->{$letter}] = $line;
19  # print ord $chrmap->{$letter}, " $line\n";
20}
21
22sub output_tables {
23  my %arrays;
24
25  my $chrmap = shift;
26  foreach (@_) {
27    my ($letter, $shriek, $spare, $nocsum, $size, $condition)
28      = /^([A-Za-z])(!?)\t(\S*)\t(\S*)\t([^\t\n]+)(?:\t+(.*))?$/;
29    die "Can't parse '$_'" unless $size;
30
31    if (defined $condition) {
32	$condition = join " && ", map {"defined($_)"} split ' ', $condition;
33    }
34    unless ($size =~ s/^=//) {
35      $size = "sizeof($size)";
36    }
37
38    addline (\%arrays, $chrmap, $letter, $shriek ? 'shrieking' : 'normal',
39	     $spare, $nocsum, $size, $condition);
40  }
41
42  my %earliest;
43  foreach my $arrayname (sort keys %arrays) {
44    my $array = $arrays{$arrayname};
45    die "No defined entries in $arrayname" unless $array->[$#$array];
46    # Find the first used entry
47    my $earliest = 0;
48    $earliest++ while (!$array->[$earliest]);
49    # Remove all the empty elements.
50    splice @$array, 0, $earliest;
51    print "unsigned char size_${arrayname}[", scalar @$array, "] = {\n";
52    my @lines;
53    foreach (@$array) {
54	# Remove the assumption here that the last entry isn't conditonal
55	if (ref $_) {
56	    push @lines,
57	      ["#if $_->[0]", "  $_->[1]", "#else", "  0,", "#endif"];
58	} else {
59	    push @lines, $_ ? "  $_" : "  0,";
60	}
61    }
62    # remove the last, annoying, comma
63    my $last = $lines[$#lines];
64    my $got;
65    foreach (ref $last ? @$last : $last) {
66      $got += s/,$//;
67    }
68    die "Last entry had no commas" unless $got;
69    print map {"$_\n"} ref $_ ? @$_ : $_ foreach @lines;
70    print "};\n";
71    $earliest{$arrayname} = $earliest;
72  }
73
74  print "struct packsize_t packsize[2] = {\n";
75
76  my @lines;
77  foreach (qw(normal shrieking)) {
78    my $array = $arrays{$_};
79    push @lines, "  {size_$_, $earliest{$_}, " . (scalar @$array) . "},";
80  }
81  # remove the last, annoying, comma
82  chop $lines[$#lines];
83  print "$_\n" foreach @lines;
84  print "};\n";
85}
86
87my %asciimap = (map {chr $_, chr $_} 0..255);
88my %ebcdicmap = (map {chr $_, Encode::encode ("posix-bc", chr $_)} 0..255);
89
90print <<'EOC';
91#if 'J'-'I' == 1
92/* ASCII */
93EOC
94output_tables (\%asciimap, @lines);
95print <<'EOC';
96#else
97/* EBCDIC (or bust) */
98EOC
99output_tables (\%ebcdicmap, @lines);
100print "#endif\n";
101
102__DATA__
103#Symbol	spare	nocsum	size
104c			char
105C			unsigned char
106U			char
107s!			short
108s			=SIZE16
109S!			unsigned short
110v			=SIZE16
111n			=SIZE16
112S			=SIZE16
113v!			=SIZE16	PERL_PACK_CAN_SHRIEKSIGN
114n!			=SIZE16	PERL_PACK_CAN_SHRIEKSIGN
115i			int
116i!			int
117I			unsigned int
118I!			unsigned int
119j			=IVSIZE
120J			=UVSIZE
121l!			long
122l			=SIZE32
123L!			unsigned long
124V			=SIZE32
125N			=SIZE32
126V!			=SIZE32	PERL_PACK_CAN_SHRIEKSIGN
127N!			=SIZE32	PERL_PACK_CAN_SHRIEKSIGN
128L			=SIZE32
129p		*	char *
130w		*	char
131q			Quad_t	HAS_QUAD
132Q			Uquad_t	HAS_QUAD
133f			float
134d			double
135F			=NVSIZE
136D			=LONG_DOUBLESIZE	HAS_LONG_DOUBLE USE_LONG_DOUBLE
137