1eval 'exec /usr/athena/bin/perl -S $0 ${1+"$@"}' 2 if $running_under_some_shell; 3 # this emulates #! processing on NIH machines. 4 # (remove #! line above if indigestible) 5 6eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift; 7 # process any FOO=bar switches 8 9$[ = 1; # set array base to 1 10$, = ' '; # set output field separator 11$\ = "\n"; # set output record separator 12 13$char_shift = 64; 14## "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"; 15$c2n{'A'} = 1; 16$c2n{'B'} = 2; 17$c2n{'C'} = 3; 18$c2n{'D'} = 4; 19$c2n{'E'} = 5; 20$c2n{'F'} = 6; 21$c2n{'G'} = 7; 22$c2n{'H'} = 8; 23$c2n{'I'} = 9; 24$c2n{'J'} = 10; 25$c2n{'K'} = 11; 26$c2n{'L'} = 12; 27$c2n{'M'} = 13; 28$c2n{'N'} = 14; 29$c2n{'O'} = 15; 30$c2n{'P'} = 16; 31$c2n{'Q'} = 17; 32$c2n{'R'} = 18; 33$c2n{'S'} = 19; 34$c2n{'T'} = 20; 35$c2n{'U'} = 21; 36$c2n{'V'} = 22; 37$c2n{'W'} = 23; 38$c2n{'X'} = 24; 39$c2n{'Y'} = 25; 40$c2n{'Z'} = 26; 41$c2n{'a'} = 27; 42$c2n{'b'} = 28; 43$c2n{'c'} = 29; 44$c2n{'d'} = 30; 45$c2n{'e'} = 31; 46$c2n{'f'} = 32; 47$c2n{'g'} = 33; 48$c2n{'h'} = 34; 49$c2n{'i'} = 35; 50$c2n{'j'} = 36; 51$c2n{'k'} = 37; 52$c2n{'l'} = 38; 53$c2n{'m'} = 39; 54$c2n{'n'} = 40; 55$c2n{'o'} = 41; 56$c2n{'p'} = 42; 57$c2n{'q'} = 43; 58$c2n{'r'} = 44; 59$c2n{'s'} = 45; 60$c2n{'t'} = 46; 61$c2n{'u'} = 47; 62$c2n{'v'} = 48; 63$c2n{'w'} = 49; 64$c2n{'x'} = 50; 65$c2n{'y'} = 51; 66$c2n{'z'} = 52; 67$c2n{'0'} = 53; 68$c2n{'1'} = 54; 69$c2n{'2'} = 55; 70$c2n{'3'} = 56; 71$c2n{'4'} = 57; 72$c2n{'5'} = 58; 73$c2n{'6'} = 59; 74$c2n{'7'} = 60; 75$c2n{'8'} = 61; 76$c2n{'9'} = 62; 77$c2n{'_'} = 63; 78 79line: while (<>) { 80 ($Fld1,$Fld2) = split(' ', $_, 9999); 81 if (/^#/) { 82 next line; 83 } 84 if (/^[ \t]*(error_table|et)[ \t]+[a-zA-Z][a-zA-Z0-9_]+/) { 85 $table_number = 0; 86 $table_name = $Fld2; 87 $mod_base = 1000000; 88 for ($i = 1; $i <= length($table_name); $i++) { 89 $table_number = ($table_number * $char_shift) + 90 91 $c2n{substr($table_name, $i, 1)}; 92 } 93 # We start playing *_high, *low games here because the some 94 # awk programs do not have the necessary precision (sigh) 95 $tab_base_low = $table_number % $mod_base; 96 $tab_base_high = int($table_number / $mod_base); 97 $tab_base_sign = 1; 98 99 # figure out: table_number_base=table_number*256 100 $tab_base_low = $tab_base_low * 256; 101 $tab_base_high = ($tab_base_high * 256) + int($tab_base_low / 102 103 $mod_base); 104 $tab_base_low = $tab_base_low % $mod_base; 105 106 if ($table_number > 128 * 256 * 256) { 107 # figure out: table_number_base -= 256*256*256*256 108 # sub_high, sub_low is 256*256*256*256 109 $sub_low = 256 * 256 * 256 % $mod_base; 110 $sub_high = int(256 * 256 * 256 / $mod_base); 111 112 $sub_low = $sub_low * 256; 113 $sub_high = ($sub_high * 256) + int($sub_low / $mod_base); 114 $sub_low = $sub_low % $mod_base; 115 116 $tab_base_low = $sub_low - $tab_base_low; 117 $tab_base_high = $sub_high - $tab_base_high; 118 $tab_base_sign = -1; 119 if ($tab_base_low < 0) { 120 $tab_base_low = $tab_base_low + $mod_base; 121 $tab_base_high--; 122 } 123 } 124 $curr_low = $tab_base_low; 125 $curr_high = $tab_base_high; 126 $curr_sign = $tab_base_sign; 127 &Pick('>', $outfile) && 128 (print $fh '/*'); 129 &Pick('>', $outfile) && 130 (print $fh ' * ' . $outfile . ':'); 131 &Pick('>', $outfile) && 132 (print $fh 133 134 ' * This file is automatically generated; please do not edit it.'); 135 &Pick('>', $outfile) && 136 (print $fh ' */'); 137 &Pick('>', $outfile) && 138 (print $fh ''); 139 &Pick('>', $outfile) && 140 (print $fh '#include <com_err.h>'); 141 &Pick('>', $outfile) && 142 (print $fh ''); 143 $table_item_count = 0; 144 } 145 146 if (/^[ \t]*(error_code|ec)[ \t]+[A-Z_0-9]+,/) { 147 $tag = substr($Fld2, 1, length($Fld2) - 1); 148 if ($curr_high == 0) { 149 &Pick('>', $outfile) && 150 (printf $fh "#define %-40s (%dL)\n", $tag, 151 152 $curr_sign * $curr_low); 153 } 154 else { 155 &Pick('>', $outfile) && 156 (printf $fh "#define %-40s (%d%06dL)\n", $tag, 157 158 $curr_high * $curr_sign, $curr_low); 159 } 160 $curr_low += $curr_sign; 161 if ($curr_low >= $mod_base) { #??? 162 $curr_low -= $mod_base; 163 $curr_high++; 164 } 165 if ($curr_low < 0) { 166 $cur_low += $mod_base; 167 $cur_high--; 168 } 169 } 170} 171 172if ($table_item_count > 256) { 173 &Pick('|', 'cat 1>&2') && 174 (print $fh 'Error table too large!'); 175 exit 1; 176} 177if ($tab_base_high == 0) { 178 &Pick('>', $outfile) && 179 (print $fh '#define ERROR_TABLE_BASE_' . $table_name . ' (' . 180 181 sprintf('%d', $tab_base_sign * $tab_base_low) . 'L)'); 182} 183else { 184 &Pick('>', $outfile) && 185 (print $fh '#define ERROR_TABLE_BASE_' . $table_name . ' (' . 186 187 sprintf('%d%06d', $tab_base_sign * $tab_base_high, 188 189 $tab_base_low) . 'L)'); 190} 191&Pick('>', $outfile) && 192 (print $fh ''); 193&Pick('>', $outfile) && 194 (print $fh 'extern const struct error_table et_' . $table_name . 195 196 '_error_table;'); 197&Pick('>', $outfile) && 198 (print $fh ''); 199&Pick('>', $outfile) && 200 (print $fh '#if !defined(_WIN32)'); 201&Pick('>', $outfile) && 202 (print $fh '/* for compatibility with older versions... */'); 203&Pick('>', $outfile) && 204 (print $fh 'extern void initialize_' . $table_name . 205 206 '_error_table (void) /*@modifies internalState@*/;'); 207&Pick('>', $outfile) && 208 (print $fh '#else'); 209&Pick('>', $outfile) && 210 (print $fh '#define initialize_' . $table_name . '_error_table()'); 211&Pick('>', $outfile) && 212 (print $fh '#endif'); 213&Pick('>', $outfile) && 214 (print $fh ''); 215&Pick('>', $outfile) && 216 (print $fh '#if !defined(_WIN32)'); 217&Pick('>', $outfile) && 218 (print $fh '#define init_' . $table_name . '_err_tbl initialize_' . 219 220 $table_name . '_error_table'); 221&Pick('>', $outfile) && 222 (print $fh '#define ' . $table_name . '_err_base ERROR_TABLE_BASE_' . 223 224 $table_name); 225&Pick('>', $outfile) && 226 (print $fh '#endif'); 227 228exit $ExitValue; 229 230sub Pick { 231 local($mode,$name,$pipe) = @_; 232 $fh = $name; 233 open($name,$mode.$name.$pipe) unless $opened{$name}++; 234} 235