| 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) |
| 4 | use strict; |
| 5 | use Encode; |
| 6 | |
| 7 | sub 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 | |
| 25 | sub 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 = "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 | |
| 61 | my @lines = grep { |
| 62 | s/#.*//; |
| 63 | /\S/; |
| 64 | } <DATA>; |
| 65 | |
| 66 | my %asciimap = map {chr $_, chr $_} 0..255; |
| 67 | my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255; |
| 68 | |
| 69 | print <<"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 | |
| 77 | typedef 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 |
| 85 | EOC |
| 86 | |
| 87 | __DATA__ |
| 88 | #Symbol unpredictable |
| 89 | # nocsum size |
| 90 | c char |
| 91 | C * unsigned char |
| 92 | W * unsigned char |
| 93 | U * char |
| 94 | s! short |
| 95 | s =SIZE16 |
| 96 | S! unsigned short |
| 97 | v =SIZE16 |
| 98 | n =SIZE16 |
| 99 | S =SIZE16 |
| 100 | v! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN |
| 101 | n! =SIZE16 PERL_PACK_CAN_SHRIEKSIGN |
| 102 | i int |
| 103 | i! int |
| 104 | I unsigned int |
| 105 | I! unsigned int |
| 106 | j =IVSIZE |
| 107 | J =UVSIZE |
| 108 | l! long |
| 109 | l =SIZE32 |
| 110 | L! unsigned long |
| 111 | V =SIZE32 |
| 112 | N =SIZE32 |
| 113 | V! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN |
| 114 | N! =SIZE32 PERL_PACK_CAN_SHRIEKSIGN |
| 115 | L =SIZE32 |
| 116 | p * char * |
| 117 | w * * char |
| 118 | q Quad_t HAS_QUAD |
| 119 | Q Uquad_t HAS_QUAD |
| 120 | f float |
| 121 | d double |
| 122 | F =NVSIZE |
| 123 | D =LONG_DOUBLESIZE HAS_LONG_DOUBLE USE_LONG_DOUBLE |