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$FS = ' '; # set field separator 11$, = ' '; # set output field separator 12$\ = "\n"; # set output record separator 13 14$char_shift = 64; 15## "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"; 16$c2n{'A'} = 1; 17$c2n{'B'} = 2; 18$c2n{'C'} = 3; 19$c2n{'D'} = 4; 20$c2n{'E'} = 5; 21$c2n{'F'} = 6; 22$c2n{'G'} = 7; 23$c2n{'H'} = 8; 24$c2n{'I'} = 9; 25$c2n{'J'} = 10; 26$c2n{'K'} = 11; 27$c2n{'L'} = 12; 28$c2n{'M'} = 13; 29$c2n{'N'} = 14; 30$c2n{'O'} = 15; 31$c2n{'P'} = 16; 32$c2n{'Q'} = 17; 33$c2n{'R'} = 18; 34$c2n{'S'} = 19; 35$c2n{'T'} = 20; 36$c2n{'U'} = 21; 37$c2n{'V'} = 22; 38$c2n{'W'} = 23; 39$c2n{'X'} = 24; 40$c2n{'Y'} = 25; 41$c2n{'Z'} = 26; 42$c2n{'a'} = 27; 43$c2n{'b'} = 28; 44$c2n{'c'} = 29; 45$c2n{'d'} = 30; 46$c2n{'e'} = 31; 47$c2n{'f'} = 32; 48$c2n{'g'} = 33; 49$c2n{'h'} = 34; 50$c2n{'i'} = 35; 51$c2n{'j'} = 36; 52$c2n{'k'} = 37; 53$c2n{'l'} = 38; 54$c2n{'m'} = 39; 55$c2n{'n'} = 40; 56$c2n{'o'} = 41; 57$c2n{'p'} = 42; 58$c2n{'q'} = 43; 59$c2n{'r'} = 44; 60$c2n{'s'} = 45; 61$c2n{'t'} = 46; 62$c2n{'u'} = 47; 63$c2n{'v'} = 48; 64$c2n{'w'} = 49; 65$c2n{'x'} = 50; 66$c2n{'y'} = 51; 67$c2n{'z'} = 52; 68$c2n{'0'} = 53; 69$c2n{'1'} = 54; 70$c2n{'2'} = 55; 71$c2n{'3'} = 56; 72$c2n{'4'} = 57; 73$c2n{'5'} = 58; 74$c2n{'6'} = 59; 75$c2n{'7'} = 60; 76$c2n{'8'} = 61; 77$c2n{'9'} = 62; 78$c2n{'_'} = 63; 79 80line: while (<>) { 81 chomp; # strip record separator 82 @Fld = split($FS, $_, 9999); 83 if (/^#/) { 84 next line; 85 } 86 if (/^[ \t]*(error_table|et)[ \t]+[a-zA-Z][a-zA-Z0-9_]+/) { 87 $table_number = 0; 88 $table_name = $Fld[2]; 89 $mod_base = 1000000; 90 for ($i = 1; $i <= length($table_name); $i++) { 91 $table_number = ($table_number * $char_shift) + 92 93 $c2n{substr($table_name, $i, 1)}; 94 } 95 96 # We start playing *_high, *low games here because the some 97 # awk programs do not have the necessary precision (sigh) 98 $tab_base_low = $table_number % $mod_base; 99 $tab_base_high = int($table_number / $mod_base); 100 $tab_base_sign = 1; 101 102 # figure out: table_number_base=table_number*256 103 $tab_base_low = $tab_base_low * 256; 104 $tab_base_high = ($tab_base_high * 256) + int($tab_base_low / 105 106 $mod_base); 107 $tab_base_low = $tab_base_low % $mod_base; 108 109 if ($table_number > 128 * 256 * 256) { 110 # figure out: table_number_base -= 256*256*256*256 111 # sub_high, sub_low is 256*256*256*256 112 $sub_low = 256 * 256 * 256 % $mod_base; 113 $sub_high = int(256 * 256 * 256 / $mod_base); 114 115 $sub_low = $sub_low * 256; 116 $sub_high = ($sub_high * 256) + int($sub_low / $mod_base); 117 $sub_low = $sub_low % $mod_base; 118 119 $tab_base_low = $sub_low - $tab_base_low; 120 $tab_base_high = $sub_high - $tab_base_high; 121 $tab_base_sign = -1; 122 if ($tab_base_low < 0) { 123 $tab_base_low = $tab_base_low + $mod_base; 124 $tab_base_high--; 125 } 126 } 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 138 &Pick('>', $outfile) && 139 (print $fh '#if defined(_WIN32)'); 140 &Pick('>', $outfile) && 141 (print $fh "# include \"win-mac.h\""); 142 &Pick('>', $outfile) && 143 (print $fh '#endif'); 144 &Pick('>', $outfile) && 145 (print $fh ''); 146 &Pick('>', $outfile) && 147 (print $fh '#if !defined(_WIN32)'); 148 &Pick('>', $outfile) && 149 (print $fh 'extern void initialize_' . $table_name . 150 151 '_error_table (void);'); 152 &Pick('>', $outfile) && 153 (print $fh '#endif'); 154 &Pick('>', $outfile) && 155 (print $fh ''); 156 &Pick('>', $outfile) && 157 (print $fh "/* Lclint doesn't handle null annotations on arrays"); 158 &Pick('>', $outfile) && 159 (print $fh ' properly, so we need this typedef in each'); 160 &Pick('>', $outfile) && 161 (print $fh ' generated .c file. */'); 162 &Pick('>', $outfile) && 163 (print $fh '/*@-redef@*/'); 164 &Pick('>', $outfile) && 165 (print $fh 'typedef /*@null@*/ const char *ncptr;'); 166 &Pick('>', $outfile) && 167 (print $fh '/*@=redef@*/'); 168 &Pick('>', $outfile) && 169 (print $fh ''); 170 &Pick('>', $outfile) && 171 (print $fh 'static ncptr const text[] = {'); 172 $table_item_count = 0; 173 } 174 175 if (($continuation == 1) && ($_ =~ /\\[ \t]*$/)) { 176 $text = substr($_, 1, length($_) - 1); 177 # printf "\t\t\"%s\"\n", text > outfile 178 $cont_buf = $cont_buf . $text; 179 } 180 181 if (($continuation == 1) && ($_ =~ /"[ \t]*$/)) { 182 # printf "\t\t\"%s,\n", $0 > outfile 183 &Pick('>', $outfile) && 184 (printf $fh "\t%s,\n", $cont_buf . $_); 185 $continuation = 0; 186 } 187 188 if (/^[ \t]*(error_code|ec)[ \t]+[A-Z_0-9]+,[ \t]*$/) { 189 $table_item_count++; 190 $skipone = 1; 191 next line; 192 } 193 194 if (/^[ \t]*(error_code|ec)[ \t]+[A-Z_0-9]+,[ \t]*".*"[ \t]*$/) { 195 $text = ''; 196 for ($i = 3; $i <= $#Fld; $i++) { 197 $text = $text . $FS . $Fld[$i]; 198 } 199 $text = substr($text, 2, length($text) - 1); 200 &Pick('>', $outfile) && 201 (printf $fh "\t%s,\n", $text); 202 $table_item_count++; 203 } 204 205 if (/^[ \t]*(error_code|ec)[ \t]+[A-Z_0-9]+,[ \t]*".*\\[ \t]*$/) { 206 $text = ''; 207 for ($i = 3; $i <= $#Fld; $i++) { 208 $text = $text . $FS . $Fld[$i]; 209 } 210 $text = substr($text, 2, length($text) - 2); 211 # printf "\t%s\"\n", text > outfile 212 $cont_buf = $text; 213 $continuation++; 214 } 215 216 if (/^[ \t]*".*\\[ \t]*$/) { 217 if ($skipone) { 218 $text = substr($_, 1, length($_) - 1); 219 # printf "\t%s\"\n", text > outfile 220 $cont_buf = $text; 221 $continuation++; 222 } 223 $skipone = 0; 224 } 225 226 if ($skipone) { 227 &Pick('>', $outfile) && 228 (printf $fh "\t%s,\n", $_); 229 } 230 $skipone = 0; 231} 232 233if ($table_item_count > 256) { 234 &Pick('|', 'cat 1>&2') && 235 (print $fh 'Error table too large!'); 236 exit 1; 237} 238&Pick('>', $outfile) && 239 (print $fh ' 0'); 240&Pick('>', $outfile) && 241 (print $fh '};'); 242&Pick('>', $outfile) && 243 (print $fh ''); 244&Pick('>', $outfile) && 245 (print $fh '#include <com_err.h>'); 246&Pick('>', $outfile) && 247 (print $fh ''); 248if ($tab_base_high == 0) { 249 &Pick('>', $outfile) && 250 (print $fh 'const struct error_table et_' . $table_name . 251 252 '_error_table = { text, ' . sprintf('%dL, %d };', 253 254 $tab_base_sign * $tab_base_low, $table_item_count)); 255} 256else { 257 &Pick('>', $outfile) && 258 (print $fh 'const struct error_table et_' . $table_name . 259 260 '_error_table = { text, ' . sprintf('%d%06dL, %d };', 261 262 $tab_base_sign * $tab_base_high, $tab_base_low, $table_item_count)); 263} 264&Pick('>', $outfile) && 265 (print $fh ''); 266&Pick('>', $outfile) && 267 (print $fh '#if !defined(_WIN32)'); 268&Pick('>', $outfile) && 269 (print $fh 'void initialize_' . $table_name . '_error_table (void)'); 270&Pick('>', $outfile) && 271 (print $fh ' /*@modifies internalState@*/'); 272&Pick('>', $outfile) && 273 (print $fh '{'); 274&Pick('>', $outfile) && 275 (print $fh ' (void) add_error_table (&et_' . $table_name . 276 277 '_error_table);'); 278&Pick('>', $outfile) && 279 (print $fh '}'); 280&Pick('>', $outfile) && 281 (print $fh '#endif'); 282 283exit $ExitValue; 284 285sub Pick { 286 local($mode,$name,$pipe) = @_; 287 $fh = $name; 288 open($name,$mode.$name.$pipe) unless $opened{$name}++; 289} 290