|
Packit |
fd8b60 |
eval 'exec /usr/athena/bin/perl -S $0 ${1+"$@"}'
|
|
Packit |
fd8b60 |
if $running_under_some_shell;
|
|
Packit |
fd8b60 |
# this emulates #! processing on NIH machines.
|
|
Packit |
fd8b60 |
# (remove #! line above if indigestible)
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
|
|
Packit |
fd8b60 |
# process any FOO=bar switches
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$[ = 1; # set array base to 1
|
|
Packit |
fd8b60 |
$, = ' '; # set output field separator
|
|
Packit |
fd8b60 |
$\ = "\n"; # set output record separator
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$char_shift = 64;
|
|
Packit |
fd8b60 |
## "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_";
|
|
Packit |
fd8b60 |
$c2n{'A'} = 1;
|
|
Packit |
fd8b60 |
$c2n{'B'} = 2;
|
|
Packit |
fd8b60 |
$c2n{'C'} = 3;
|
|
Packit |
fd8b60 |
$c2n{'D'} = 4;
|
|
Packit |
fd8b60 |
$c2n{'E'} = 5;
|
|
Packit |
fd8b60 |
$c2n{'F'} = 6;
|
|
Packit |
fd8b60 |
$c2n{'G'} = 7;
|
|
Packit |
fd8b60 |
$c2n{'H'} = 8;
|
|
Packit |
fd8b60 |
$c2n{'I'} = 9;
|
|
Packit |
fd8b60 |
$c2n{'J'} = 10;
|
|
Packit |
fd8b60 |
$c2n{'K'} = 11;
|
|
Packit |
fd8b60 |
$c2n{'L'} = 12;
|
|
Packit |
fd8b60 |
$c2n{'M'} = 13;
|
|
Packit |
fd8b60 |
$c2n{'N'} = 14;
|
|
Packit |
fd8b60 |
$c2n{'O'} = 15;
|
|
Packit |
fd8b60 |
$c2n{'P'} = 16;
|
|
Packit |
fd8b60 |
$c2n{'Q'} = 17;
|
|
Packit |
fd8b60 |
$c2n{'R'} = 18;
|
|
Packit |
fd8b60 |
$c2n{'S'} = 19;
|
|
Packit |
fd8b60 |
$c2n{'T'} = 20;
|
|
Packit |
fd8b60 |
$c2n{'U'} = 21;
|
|
Packit |
fd8b60 |
$c2n{'V'} = 22;
|
|
Packit |
fd8b60 |
$c2n{'W'} = 23;
|
|
Packit |
fd8b60 |
$c2n{'X'} = 24;
|
|
Packit |
fd8b60 |
$c2n{'Y'} = 25;
|
|
Packit |
fd8b60 |
$c2n{'Z'} = 26;
|
|
Packit |
fd8b60 |
$c2n{'a'} = 27;
|
|
Packit |
fd8b60 |
$c2n{'b'} = 28;
|
|
Packit |
fd8b60 |
$c2n{'c'} = 29;
|
|
Packit |
fd8b60 |
$c2n{'d'} = 30;
|
|
Packit |
fd8b60 |
$c2n{'e'} = 31;
|
|
Packit |
fd8b60 |
$c2n{'f'} = 32;
|
|
Packit |
fd8b60 |
$c2n{'g'} = 33;
|
|
Packit |
fd8b60 |
$c2n{'h'} = 34;
|
|
Packit |
fd8b60 |
$c2n{'i'} = 35;
|
|
Packit |
fd8b60 |
$c2n{'j'} = 36;
|
|
Packit |
fd8b60 |
$c2n{'k'} = 37;
|
|
Packit |
fd8b60 |
$c2n{'l'} = 38;
|
|
Packit |
fd8b60 |
$c2n{'m'} = 39;
|
|
Packit |
fd8b60 |
$c2n{'n'} = 40;
|
|
Packit |
fd8b60 |
$c2n{'o'} = 41;
|
|
Packit |
fd8b60 |
$c2n{'p'} = 42;
|
|
Packit |
fd8b60 |
$c2n{'q'} = 43;
|
|
Packit |
fd8b60 |
$c2n{'r'} = 44;
|
|
Packit |
fd8b60 |
$c2n{'s'} = 45;
|
|
Packit |
fd8b60 |
$c2n{'t'} = 46;
|
|
Packit |
fd8b60 |
$c2n{'u'} = 47;
|
|
Packit |
fd8b60 |
$c2n{'v'} = 48;
|
|
Packit |
fd8b60 |
$c2n{'w'} = 49;
|
|
Packit |
fd8b60 |
$c2n{'x'} = 50;
|
|
Packit |
fd8b60 |
$c2n{'y'} = 51;
|
|
Packit |
fd8b60 |
$c2n{'z'} = 52;
|
|
Packit |
fd8b60 |
$c2n{'0'} = 53;
|
|
Packit |
fd8b60 |
$c2n{'1'} = 54;
|
|
Packit |
fd8b60 |
$c2n{'2'} = 55;
|
|
Packit |
fd8b60 |
$c2n{'3'} = 56;
|
|
Packit |
fd8b60 |
$c2n{'4'} = 57;
|
|
Packit |
fd8b60 |
$c2n{'5'} = 58;
|
|
Packit |
fd8b60 |
$c2n{'6'} = 59;
|
|
Packit |
fd8b60 |
$c2n{'7'} = 60;
|
|
Packit |
fd8b60 |
$c2n{'8'} = 61;
|
|
Packit |
fd8b60 |
$c2n{'9'} = 62;
|
|
Packit |
fd8b60 |
$c2n{'_'} = 63;
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
line: while (<>) {
|
|
Packit |
fd8b60 |
($Fld1,$Fld2) = split(' ', $_, 9999);
|
|
Packit |
fd8b60 |
if (/^#/) {
|
|
Packit |
fd8b60 |
next line;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
if (/^[ \t]*(error_table|et)[ \t]+[a-zA-Z][a-zA-Z0-9_]+/) {
|
|
Packit |
fd8b60 |
$table_number = 0;
|
|
Packit |
fd8b60 |
$table_name = $Fld2;
|
|
Packit |
fd8b60 |
$mod_base = 1000000;
|
|
Packit |
fd8b60 |
for ($i = 1; $i <= length($table_name); $i++) {
|
|
Packit |
fd8b60 |
$table_number = ($table_number * $char_shift) +
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$c2n{substr($table_name, $i, 1)};
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
# We start playing *_high, *low games here because the some
|
|
Packit |
fd8b60 |
# awk programs do not have the necessary precision (sigh)
|
|
Packit |
fd8b60 |
$tab_base_low = $table_number % $mod_base;
|
|
Packit |
fd8b60 |
$tab_base_high = int($table_number / $mod_base);
|
|
Packit |
fd8b60 |
$tab_base_sign = 1;
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
# figure out: table_number_base=table_number*256
|
|
Packit |
fd8b60 |
$tab_base_low = $tab_base_low * 256;
|
|
Packit |
fd8b60 |
$tab_base_high = ($tab_base_high * 256) + int($tab_base_low /
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$mod_base);
|
|
Packit |
fd8b60 |
$tab_base_low = $tab_base_low % $mod_base;
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
if ($table_number > 128 * 256 * 256) {
|
|
Packit |
fd8b60 |
# figure out: table_number_base -= 256*256*256*256
|
|
Packit |
fd8b60 |
# sub_high, sub_low is 256*256*256*256
|
|
Packit |
fd8b60 |
$sub_low = 256 * 256 * 256 % $mod_base;
|
|
Packit |
fd8b60 |
$sub_high = int(256 * 256 * 256 / $mod_base);
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$sub_low = $sub_low * 256;
|
|
Packit |
fd8b60 |
$sub_high = ($sub_high * 256) + int($sub_low / $mod_base);
|
|
Packit |
fd8b60 |
$sub_low = $sub_low % $mod_base;
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$tab_base_low = $sub_low - $tab_base_low;
|
|
Packit |
fd8b60 |
$tab_base_high = $sub_high - $tab_base_high;
|
|
Packit |
fd8b60 |
$tab_base_sign = -1;
|
|
Packit |
fd8b60 |
if ($tab_base_low < 0) {
|
|
Packit |
fd8b60 |
$tab_base_low = $tab_base_low + $mod_base;
|
|
Packit |
fd8b60 |
$tab_base_high--;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
$curr_low = $tab_base_low;
|
|
Packit |
fd8b60 |
$curr_high = $tab_base_high;
|
|
Packit |
fd8b60 |
$curr_sign = $tab_base_sign;
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '/*');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh ' * ' . $outfile . ':');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
' * This file is automatically generated; please do not edit it.');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh ' */');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#include <com_err.h>');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '');
|
|
Packit |
fd8b60 |
$table_item_count = 0;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
if (/^[ \t]*(error_code|ec)[ \t]+[A-Z_0-9]+,/) {
|
|
Packit |
fd8b60 |
$tag = substr($Fld2, 1, length($Fld2) - 1);
|
|
Packit |
fd8b60 |
if ($curr_high == 0) {
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(printf $fh "#define %-40s (%dL)\n", $tag,
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$curr_sign * $curr_low);
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
else {
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(printf $fh "#define %-40s (%d%06dL)\n", $tag,
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$curr_high * $curr_sign, $curr_low);
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
$curr_low += $curr_sign;
|
|
Packit |
fd8b60 |
if ($curr_low >= $mod_base) { #???
|
|
Packit |
fd8b60 |
$curr_low -= $mod_base;
|
|
Packit |
fd8b60 |
$curr_high++;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
if ($curr_low < 0) {
|
|
Packit |
fd8b60 |
$cur_low += $mod_base;
|
|
Packit |
fd8b60 |
$cur_high--;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
if ($table_item_count > 256) {
|
|
Packit |
fd8b60 |
&Pick('|', 'cat 1>&2') &&
|
|
Packit |
fd8b60 |
(print $fh 'Error table too large!');
|
|
Packit |
fd8b60 |
exit 1;
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
if ($tab_base_high == 0) {
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#define ERROR_TABLE_BASE_' . $table_name . ' (' .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
sprintf('%d', $tab_base_sign * $tab_base_low) . 'L)');
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
else {
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#define ERROR_TABLE_BASE_' . $table_name . ' (' .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
sprintf('%d%06d', $tab_base_sign * $tab_base_high,
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$tab_base_low) . 'L)');
|
|
Packit |
fd8b60 |
}
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh 'extern const struct error_table et_' . $table_name .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
'_error_table;');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#if !defined(_WIN32)');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '/* for compatibility with older versions... */');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh 'extern void initialize_' . $table_name .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
'_error_table (void) /*@modifies internalState@*/;');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#else');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#define initialize_' . $table_name . '_error_table()');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#endif');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#if !defined(_WIN32)');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#define init_' . $table_name . '_err_tbl initialize_' .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$table_name . '_error_table');
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#define ' . $table_name . '_err_base ERROR_TABLE_BASE_' .
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
$table_name);
|
|
Packit |
fd8b60 |
&Pick('>', $outfile) &&
|
|
Packit |
fd8b60 |
(print $fh '#endif');
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
exit $ExitValue;
|
|
Packit |
fd8b60 |
|
|
Packit |
fd8b60 |
sub Pick {
|
|
Packit |
fd8b60 |
local($mode,$name,$pipe) = @_;
|
|
Packit |
fd8b60 |
$fh = $name;
|
|
Packit |
fd8b60 |
open($name,$mode.$name.$pipe) unless $opened{$name}++;
|
|
Packit |
fd8b60 |
}
|