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