x2p/s2p.SH

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