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