x2p/s2p.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename qw(&basename &dirname);
   5
   6 # List explicitly here the variables you want Configure to
   7 # generate.  Metaconfig only looks for shell variables, so you
   8 # have to mention them as if they were shell variables, not
   9 # %Config entries.  Thus you write
  10 #  $startperl
  11 # to ensure Configure will look for $Config{startperl}.
  12
  13 # This forces PL files to create target in same directory as PL file.
  14 # This is so that make depend always knows where to find PL derivatives.
  15 chdir(dirname($0));
  16 ($file = basename($0)) =~ s/\.PL$//;
  17 $file =~ s/\.pl$//
  18         if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
  19
  20 open OUT,">$file" or die "Can't create $file: $!";
  21
  22 print "Extracting $file (with variable substitutions)\n";
  23
  24 # In this section, perl variables will be expanded during extraction.
  25 # You can use $Config{...} to use Configure variables.
  26
  27 print OUT <<"!GROK!THIS!";
  28 $Config{'startperl'}
  29     eval 'exec perl -S \$0 "\$@"'
  30         if 0;
  31 \$startperl = "$Config{startperl}";
  32 !GROK!THIS!
  33
  34 # In the following, perl variables are not expanded during extraction.
  35
  36 print OUT <<'!NO!SUBS!';
  37
  38 # $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
  39 #
  40 # $Log: s2p.SH,v $
  41
  42 $indent = 4;
  43 $shiftwidth = 4;
  44 $l = '{'; $r = '}';
  45
  46 while ($ARGV[0] =~ /^-/) {
  47     $_ = shift;
  48   last if /^--/;
  49     if (/^-D/) {
  50         $debug++;
  51         open(BODY,'>-');
  52         next;
  53     }
  54     if (/^-n/) {
  55         $assumen++;
  56         next;
  57     }
  58     if (/^-p/) {
  59         $assumep++;
  60         next;
  61     }
  62     die "I don't recognize this switch: $_\n";
  63 }
  64
  65 unless ($debug) {
  66     open(BODY,">/tmp/sperl$$") ||
  67       &Die("Can't open temp file: $!\n");
  68 }
  69
  70 if (!$assumen && !$assumep) {
  71     print BODY &q(<<'EOT');
  72 :       while ($ARGV[0] =~ /^-/) {
  73 :           $_ = shift;
  74 :         last if /^--/;
  75 :           if (/^-n/) {
  76 :               $nflag++;
  77 :               next;
  78 :           }
  79 :           die "I don't recognize this switch: $_\\n";
  80 :       }
  81 :
  82 EOT
  83 }
  84
  85 print BODY &q(<<'EOT');
  86 :       #ifdef PRINTIT
  87 :       #ifdef ASSUMEP
  88 :       $printit++;
  89 :       #else
  90 :       $printit++ unless $nflag;
  91 :       #endif
  92 :       #endif
  93 :       <><>
  94 :       $\ = "\n";              # automatically add newline on print
  95 :       <><>
  96 :       #ifdef TOPLABEL
  97 :       LINE:
  98 :       while (chop($_ = <>)) {
  99 :       #else
 100 :       LINE:
 101 :       while (<>) {
 102 :           chop;
 103 :       #endif
 104 EOT
 105
 106 LINE:
 107 while (<>) {
 108
 109     # Wipe out surrounding whitespace.
 110
 111     s/[ \t]*(.*)\n$/$1/;
 112
 113     # Perhaps it's a label/comment.
 114
 115     if (/^:/) {
 116         s/^:[ \t]*//;
 117         $label = &make_label($_);
 118         if ($. == 1) {
 119             $toplabel = $label;
 120             if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
 121                 $_ = <>;
 122                 redo LINE; # Never referenced, so delete it if not a comment.
 123             }
 124         }
 125         $_ = "$label:";
 126         if ($lastlinewaslabel++) {
 127             $indent += 4;
 128             print BODY &tab, ";\n";
 129             $indent -= 4;
 130         }
 131         if ($indent >= 2) {
 132             $indent -= 2;
 133             $indmod = 2;
 134         }
 135         next;
 136     } else {
 137         $lastlinewaslabel = '';
 138     }
 139
 140     # Look for one or two address clauses
 141
 142     $addr1 = '';
 143     $addr2 = '';
 144     if (s/^([0-9]+)//) {
 145         $addr1 = "$1";
 146         $addr1 = "\$. == $addr1" unless /^,/;
 147     }
 148     elsif (s/^\$//) {
 149         $addr1 = 'eof()';
 150     }
 151     elsif (s|^/||) {
 152         $addr1 = &fetchpat('/');
 153     }
 154     if (s/^,//) {
 155         if (s/^([0-9]+)//) {
 156             $addr2 = "$1";
 157         } elsif (s/^\$//) {
 158             $addr2 = "eof()";
 159         } elsif (s|^/||) {
 160             $addr2 = &fetchpat('/');
 161         } else {
 162             &Die("Invalid second address at line $.\n");
 163         }
 164         if ($addr2 =~ /^\d+$/) {
 165             $addr1 .= "..$addr2";
 166         }
 167         else {
 168             $addr1 .= "...$addr2";
 169         }
 170     }
 171
 172     # Now we check for metacommands {, }, and ! and worry
 173     # about indentation.
 174
 175     s/^[ \t]+//;
 176     # a { to keep vi happy
 177     if ($_ eq '}') {
 178         $indent -= 4;
 179         next;
 180     }
 181     if (s/^!//) {
 182         $if = 'unless';
 183         $else = "$r else $l\n";
 184     } else {
 185         $if = 'if';
 186         $else = '';
 187     }
 188     if (s/^{//) {       # a } to keep vi happy
 189         $indmod = 4;
 190         $redo = $_;
 191         $_ = '';
 192         $rmaybe = '';
 193     } else {
 194         $rmaybe = "\n$r";
 195         if ($addr2 || $addr1) {
 196             $space = ' ' x $shiftwidth;
 197         } else {
 198             $space = '';
 199         }
 200         $_ = &transmogrify();
 201     }
 202
 203     # See if we can optimize to modifier form.
 204
 205     if ($addr1) {
 206         if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
 207           $_ !~ / if / && $_ !~ / unless /) {
 208             s/;$/ $if $addr1;/;
 209             $_ = substr($_,$shiftwidth,1000);
 210         } else {
 211             $_ = "$if ($addr1) $l\n$change$_$rmaybe";
 212         }
 213         $change = '';
 214         next LINE;
 215     }
 216 } continue {
 217     @lines = split(/\n/,$_);
 218     for (@lines) {
 219         unless (s/^ *<<--//) {
 220             print BODY &tab;
 221         }
 222         print BODY $_, "\n";
 223     }
 224     $indent += $indmod;
 225     $indmod = 0;
 226     if ($redo) {
 227         $_ = $redo;
 228         $redo = '';
 229         redo LINE;
 230     }
 231 }
 232 if ($lastlinewaslabel++) {
 233     $indent += 4;
 234     print BODY &tab, ";\n";
 235     $indent -= 4;
 236 }
 237
 238 if ($appendseen || $tseen || !$assumen) {
 239     $printit++ if $dseen || (!$assumen && !$assumep);
 240     print BODY &q(<<'EOT');
 241 :       #ifdef SAWNEXT
 242 :       }
 243 :       continue {
 244 :       #endif
 245 :       #ifdef PRINTIT
 246 :       #ifdef DSEEN
 247 :       #ifdef ASSUMEP
 248 :           print if $printit++;
 249 :       #else
 250 :           if ($printit)
 251 :               { print; }
 252 :           else
 253 :               { $printit++ unless $nflag; }
 254 :       #endif
 255 :       #else
 256 :           print if $printit;
 257 :       #endif
 258 :       #else
 259 :           print;
 260 :       #endif
 261 :       #ifdef TSEEN
 262 :           $tflag = 0;
 263 :       #endif
 264 :       #ifdef APPENDSEEN
 265 :           if ($atext) { chop $atext; print $atext; $atext = ''; }
 266 :       #endif
 267 EOT
 268
 269 print BODY &q(<<'EOT');
 270 :       }
 271 EOT
 272 }
 273
 274 close BODY;
 275
 276 unless ($debug) {
 277     open(HEAD,">/tmp/sperl2$$.c")
 278       || &Die("Can't open temp file 2: $!\n");
 279     print HEAD "#define PRINTIT\n"      if $printit;
 280     print HEAD "#define APPENDSEEN\n"   if $appendseen;
 281     print HEAD "#define TSEEN\n"        if $tseen;
 282     print HEAD "#define DSEEN\n"        if $dseen;
 283     print HEAD "#define ASSUMEN\n"      if $assumen;
 284     print HEAD "#define ASSUMEP\n"      if $assumep;
 285     print HEAD "#define TOPLABEL\n"     if $toplabel;
 286     print HEAD "#define SAWNEXT\n"      if $sawnext;
 287     if ($opens) {print HEAD "$opens\n";}
 288     open(BODY,"/tmp/sperl$$")
 289       || &Die("Can't reopen temp file: $!\n");
 290     while (<BODY>) {
 291         print HEAD $_;
 292     }
 293     close HEAD;
 294
 295     print &q(<<"EOT");
 296 :       $startperl
 297 :       eval 'exec perl -S \$0 \${1+"\$@"}'
 298 :               if \$running_under_some_shell;
 299 :
 300 EOT
 301     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
 302         &Die("Can't reopen temp file: $!\n");
 303     while (<BODY>) {
 304         /^# [0-9]/ && next;
 305         /^[ \t]*$/ && next;
 306         s/^<><>//;
 307         print;
 308     }
 309 }
 310
 311 &Cleanup;
 312 exit;
 313
 314 sub Cleanup {
 315     chdir "/tmp";
 316     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
 317 }
 318 sub Die {
 319     &Cleanup;
 320     die $_[0];
 321 }
 322 sub tab {
 323     "\t" x ($indent / 8) . ' ' x ($indent % 8);
 324 }
 325 sub make_filehandle {
 326     local($_) = $_[0];
 327     local($fname) = $_;
 328     if (!$seen{$fname}) {
 329         $_ = "FH_" . $_ if /^\d/;
 330         s/[^a-zA-Z0-9]/_/g;
 331         s/^_*//;
 332         $_ = "\U$_";
 333         if ($fhseen{$_}) {
 334             for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
 335             $_ .= $tmp;
 336         }
 337         $fhseen{$_} = 1;
 338         $opens .= &q(<<"EOT");
 339 :       open($_, '>$fname') || die "Can't create $fname: \$!";
 340 EOT
 341         $seen{$fname} = $_;
 342     }
 343     $seen{$fname};
 344 }
 345
 346 sub make_label {
 347     local($label) = @_;
 348     $label =~ s/[^a-zA-Z0-9]/_/g;
 349     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
 350     $label = substr($label,0,8);
 351
 352     # Could be a reserved word, so capitalize it.
 353     substr($label,0,1) =~ y/a-z/A-Z/
 354       if $label =~ /^[a-z]/;
 355
 356     $label;
 357 }
 358
 359 sub transmogrify {
 360     {   # case
 361         if (/^d/) {
 362             $dseen++;
 363             chop($_ = &q(<<'EOT'));
 364 :       <<--#ifdef PRINTIT
 365 :       $printit = 0;
 366 :       <<--#endif
 367 :       next LINE;
 368 EOT
 369             $sawnext++;
 370             next;
 371         }
 372
 373         if (/^n/) {
 374             chop($_ = &q(<<'EOT'));
 375 :       <<--#ifdef PRINTIT
 376 :       <<--#ifdef DSEEN
 377 :       <<--#ifdef ASSUMEP
 378 :       print if $printit++;
 379 :       <<--#else
 380 :       if ($printit)
 381 :           { print; }
 382 :       else
 383 :           { $printit++ unless $nflag; }
 384 :       <<--#endif
 385 :       <<--#else
 386 :       print if $printit;
 387 :       <<--#endif
 388 :       <<--#else
 389 :       print;
 390 :       <<--#endif
 391 :       <<--#ifdef APPENDSEEN
 392 :       if ($atext) {chop $atext; print $atext; $atext = '';}
 393 :       <<--#endif
 394 :       $_ = <>;
 395 :       chop;
 396 :       <<--#ifdef TSEEN
 397 :       $tflag = 0;
 398 :       <<--#endif
 399 EOT
 400             next;
 401         }
 402
 403         if (/^a/) {
 404             $appendseen++;
 405             $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
 406             $lastline = 0;
 407             while (<>) {
 408                 s/^[ \t]*//;
 409                 s/^[\\]//;
 410                 unless (s|\\$||) { $lastline = 1;}
 411                 s/^([ \t]*\n)/<><>$1/;
 412                 $command .= $_;
 413                 $command .= '<<--';
 414                 last if $lastline;
 415             }
 416             $_ = $command . "End_Of_Text";
 417             last;
 418         }
 419
 420         if (/^[ic]/) {
 421             if (/^c/) { $change = 1; }
 422             $addr1 = 1 if $addr1 eq '';
 423             $addr1 = '$iter = (' . $addr1 . ')';
 424             $command = $space .
 425               "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
 426             $lastline = 0;
 427             while (<>) {
 428                 s/^[ \t]*//;
 429                 s/^[\\]//;
 430                 unless (s/\\$//) { $lastline = 1;}
 431                 s/'/\\'/g;
 432                 s/^([ \t]*\n)/<><>$1/;
 433                 $command .= $_;
 434                 $command .= '<<--';
 435                 last if $lastline;
 436             }
 437             $_ = $command . "End_Of_Text";
 438             if ($change) {
 439                 $dseen++;
 440                 $change = "$_\n";
 441                 chop($_ = &q(<<"EOT"));
 442 :       <<--#ifdef PRINTIT
 443 :       $space\$printit = 0;
 444 :       <<--#endif
 445 :       ${space}next LINE;
 446 EOT
 447                 $sawnext++;
 448             }
 449             last;
 450         }
 451
 452         if (/^s/) {
 453             $delim = substr($_,1,1);
 454             $len = length($_);
 455             $repl = $end = 0;
 456             $inbracket = 0;
 457             for ($i = 2; $i < $len; $i++) {
 458                 $c = substr($_,$i,1);
 459                 if ($c eq $delim) {
 460                     if ($inbracket) {
 461                         substr($_, $i, 0) = '\\';
 462                         $i++;
 463                         $len++;
 464                     }
 465                     else {
 466                         if ($repl) {
 467                             $end = $i;
 468                             last;
 469                         } else {
 470                             $repl = $i;
 471                         }
 472                     }
 473                 }
 474                 elsif ($c eq '\\') {
 475                     $i++;
 476                     if ($i >= $len) {
 477                         $_ .= 'n';
 478                         $_ .= <>;
 479                         $len = length($_);
 480                         $_ = substr($_,0,--$len);
 481                     }
 482                     elsif (substr($_,$i,1) =~ /^[n]$/) {
 483                         ;
 484                     }
 485                     elsif (!$repl &&
 486                       substr($_,$i,1) =~ /^[(){}\w]$/) {
 487                         $i--;
 488                         $len--;
 489                         substr($_, $i, 1) = '';
 490                     }
 491                     elsif (!$repl &&
 492                       substr($_,$i,1) =~ /^[<>]$/) {
 493                         substr($_,$i,1) = 'b';
 494                     }
 495                     elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
 496                         substr($_,$i-1,1) = '$';
 497                     }
 498                 }
 499                 elsif ($c eq '&' && $repl) {
 500                     substr($_, $i, 0) = '$';
 501                     $i++;
 502                     $len++;
 503                 }
 504                 elsif ($c eq '$' && $repl) {
 505                     substr($_, $i, 0) = '\\';
 506                     $i++;
 507                     $len++;
 508                 }
 509                 elsif ($c eq '[' && !$repl) {
 510                     $i++ if substr($_,$i,1) eq '^';
 511                     $i++ if substr($_,$i,1) eq ']';
 512                     $inbracket = 1;
 513                 }
 514                 elsif ($c eq ']') {
 515                     $inbracket = 0;
 516                 }
 517                 elsif ($c eq "\t") {
 518                     substr($_, $i, 1) = '\\t';
 519                     $i++;
 520                     $len++;
 521                 }
 522                 elsif (!$repl && index("()+",$c) >= 0) {
 523                     substr($_, $i, 0) = '\\';
 524                     $i++;
 525                     $len++;
 526                 }
 527             }
 528             &Die("Malformed substitution at line $.\n")
 529               unless $end;
 530             $pat = substr($_, 0, $repl + 1);
 531             $repl = substr($_, $repl+1, $end-$repl-1);
 532             $end = substr($_, $end + 1, 1000);
 533             &simplify($pat);
 534             $dol = '$';
 535             $subst = "$pat$repl$delim";
 536             $cmd = '';
 537             while ($end) {
 538                 if ($end =~ s/^g//) {
 539                     $subst .= 'g';
 540                     next;
 541                 }
 542                 if ($end =~ s/^p//) {
 543                     $cmd .= ' && (print)';
 544                     next;
 545                 }
 546                 if ($end =~ s/^w[ \t]*//) {
 547                     $fh = &make_filehandle($end);
 548                     $cmd .= " && (print $fh \$_)";
 549                     $end = '';
 550                     next;
 551                 }
 552                 &Die("Unrecognized substitution command".
 553                   "($end) at line $.\n");
 554             }
 555             chop ($_ = &q(<<"EOT"));
 556 :       <<--#ifdef TSEEN
 557 :       $subst && \$tflag++$cmd;
 558 :       <<--#else
 559 :       $subst$cmd;
 560 :       <<--#endif
 561 EOT
 562             next;
 563         }
 564
 565         if (/^p/) {
 566             $_ = 'print;';
 567             next;
 568         }
 569
 570         if (/^w/) {
 571             s/^w[ \t]*//;
 572             $fh = &make_filehandle($_);
 573             $_ = "print $fh \$_;";
 574             next;
 575         }
 576
 577         if (/^r/) {
 578             $appendseen++;
 579             s/^r[ \t]*//;
 580             $file = $_;
 581             $_ = "\$atext .= `cat $file 2>/dev/null`;";
 582             next;
 583         }
 584
 585         if (/^P/) {
 586             $_ = 'print $1 if /^(.*)/;';
 587             next;
 588         }
 589
 590         if (/^D/) {
 591             chop($_ = &q(<<'EOT'));
 592 :       s/^.*\n?//;
 593 :       redo LINE if $_;
 594 :       next LINE;
 595 EOT
 596             $sawnext++;
 597             next;
 598         }
 599
 600         if (/^N/) {
 601             chop($_ = &q(<<'EOT'));
 602 :       $_ .= "\n";
 603 :       $len1 = length;
 604 :       $_ .= <>;
 605 :       chop if $len1 < length;
 606 :       <<--#ifdef TSEEN
 607 :       $tflag = 0;
 608 :       <<--#endif
 609 EOT
 610             next;
 611         }
 612
 613         if (/^h/) {
 614             $_ = '$hold = $_;';
 615             next;
 616         }
 617
 618         if (/^H/) {
 619             $_ = '$hold .= "\n"; $hold .= $_;';
 620             next;
 621         }
 622
 623         if (/^g/) {
 624             $_ = '$_ = $hold;';
 625             next;
 626         }
 627
 628         if (/^G/) {
 629             $_ = '$_ .= "\n"; $_ .= $hold;';
 630             next;
 631         }
 632
 633         if (/^x/) {
 634             $_ = '($_, $hold) = ($hold, $_);';
 635             next;
 636         }
 637
 638         if (/^b$/) {
 639             $_ = 'next LINE;';
 640             $sawnext++;
 641             next;
 642         }
 643
 644         if (/^b/) {
 645             s/^b[ \t]*//;
 646             $lab = &make_label($_);
 647             if ($lab eq $toplabel) {
 648                 $_ = 'redo LINE;';
 649             } else {
 650                 $_ = "goto $lab;";
 651             }
 652             next;
 653         }
 654
 655         if (/^t$/) {
 656             $_ = 'next LINE if $tflag;';
 657             $sawnext++;
 658             $tseen++;
 659             next;
 660         }
 661
 662         if (/^t/) {
 663             s/^t[ \t]*//;
 664             $lab = &make_label($_);
 665             $_ = q/if ($tflag) {$tflag = 0; /;
 666             if ($lab eq $toplabel) {
 667                 $_ .= 'redo LINE;}';
 668             } else {
 669                 $_ .= "goto $lab;}";
 670             }
 671             $tseen++;
 672             next;
 673         }
 674
 675         if (/^y/) {
 676             s/abcdefghijklmnopqrstuvwxyz/a-z/g;
 677             s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
 678             s/abcdef/a-f/g;
 679             s/ABCDEF/A-F/g;
 680             s/0123456789/0-9/g;
 681             s/01234567/0-7/g;
 682             $_ .= ';';
 683         }
 684
 685         if (/^=/) {
 686             $_ = 'print $.;';
 687             next;
 688         }
 689
 690         if (/^q/) {
 691             chop($_ = &q(<<'EOT'));
 692 :       close(ARGV);
 693 :       @ARGV = ();
 694 :       next LINE;
 695 EOT
 696             $sawnext++;
 697             next;
 698         }
 699     } continue {
 700         if ($space) {
 701             s/^/$space/;
 702             s/(\n)(.)/$1$space$2/g;
 703         }
 704         last;
 705     }
 706     $_;
 707 }
 708
 709 sub fetchpat {
 710     local($outer) = @_;
 711     local($addr) = $outer;
 712     local($inbracket);
 713     local($prefix,$delim,$ch);
 714
 715     # Process pattern one potential delimiter at a time.
 716
 717     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
 718         $prefix = $1;
 719         $delim = $2;
 720         if ($delim eq '\\') {
 721             s/(.)//;
 722             $ch = $1;
 723             $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
 724             $ch = 'b' if $ch =~ /^[<>]$/;
 725             $delim .= $ch;
 726         }
 727         elsif ($delim eq '[') {
 728             $inbracket = 1;
 729             s/^\^// && ($delim .= '^');
 730             s/^]// && ($delim .= ']');
 731         }
 732         elsif ($delim eq ']') {
 733             $inbracket = 0;
 734         }
 735         elsif ($inbracket || $delim ne $outer) {
 736             $delim = '\\' . $delim;
 737         }
 738         $addr .= $prefix;
 739         $addr .= $delim;
 740         if ($delim eq $outer && !$inbracket) {
 741             last DELIM;
 742         }
 743     }
 744     $addr =~ s/\t/\\t/g;
 745     &simplify($addr);
 746     $addr;
 747 }
 748
 749 sub q {
 750     local($string) = @_;
 751     local($*) = 1;
 752     $string =~ s/^:\t?//g;
 753     $string;
 754 }
 755
 756 sub simplify {
 757     $_[0] =~ s/_a-za-z0-9/\\w/ig;
 758     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
 759     $_[0] =~ s/a-za-z_0-9/\\w/ig;
 760     $_[0] =~ s/a-za-z0-9_/\\w/ig;
 761     $_[0] =~ s/_0-9a-za-z/\\w/ig;
 762     $_[0] =~ s/0-9_a-za-z/\\w/ig;
 763     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
 764     $_[0] =~ s/0-9a-za-z_/\\w/ig;
 765     $_[0] =~ s/\[\\w\]/\\w/g;
 766     $_[0] =~ s/\[^\\w\]/\\W/g;
 767     $_[0] =~ s/\[0-9\]/\\d/g;
 768     $_[0] =~ s/\[^0-9\]/\\D/g;
 769     $_[0] =~ s/\\d\\d\*/\\d+/g;
 770     $_[0] =~ s/\\D\\D\*/\\D+/g;
 771     $_[0] =~ s/\\w\\w\*/\\w+/g;
 772     $_[0] =~ s/\\t\\t\*/\\t+/g;
 773     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
 774     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
 775 }
 776
 777 !NO!SUBS!
 778
 779 close OUT or die "Can't close $file: $!";
 780 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 781 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';