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