home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / perl / os2perl / s2p.sh < prev    next >
Text File  |  1991-06-11  |  15KB  |  766 lines
  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. $spitshell >s2p <<!GROK!THIS!
  24. #!$bin/perl
  25.  
  26. \$bin = '$bin';
  27. !GROK!THIS!
  28.  
  29. : In the following dollars and backticks do not need the extra backslash.
  30. $spitshell >>s2p <<'!NO!SUBS!'
  31.  
  32. # $RCSfile: s2p.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:18 $
  33. #
  34. # $Log:    s2p.SH,v $
  35. # Revision 4.0.1.1  91/06/07  12:19:18  lwall
  36. # patch4: s2p now handles embedded newlines better and optimizes common idioms
  37. #
  38. # Revision 4.0  91/03/20  01:57:59  lwall
  39. # 4.0 baseline.
  40. #
  41. #
  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.     $addr1 .= " .. $addr2";
  166.     }
  167.  
  168.     # Now we check for metacommands {, }, and ! and worry
  169.     # about indentation.
  170.  
  171.     s/^[ \t]+//;
  172.     # a { to keep vi happy
  173.     if ($_ eq '}') {
  174.     $indent -= 4;
  175.     next;
  176.     }
  177.     if (s/^!//) {
  178.     $if = 'unless';
  179.     $else = "$r else $l\n";
  180.     } else {
  181.     $if = 'if';
  182.     $else = '';
  183.     }
  184.     if (s/^{//) {    # a } to keep vi happy
  185.     $indmod = 4;
  186.     $redo = $_;
  187.     $_ = '';
  188.     $rmaybe = '';
  189.     } else {
  190.     $rmaybe = "\n$r";
  191.     if ($addr2 || $addr1) {
  192.         $space = ' ' x $shiftwidth;
  193.     } else {
  194.         $space = '';
  195.     }
  196.     $_ = &transmogrify();
  197.     }
  198.  
  199.     # See if we can optimize to modifier form.
  200.  
  201.     if ($addr1) {
  202.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  203.       $_ !~ / if / && $_ !~ / unless /) {
  204.         s/;$/ $if $addr1;/;
  205.         $_ = substr($_,$shiftwidth,1000);
  206.     } else {
  207.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  208.     }
  209.     $change = '';
  210.     next LINE;
  211.     }
  212. } continue {
  213.     @lines = split(/\n/,$_);
  214.     for (@lines) {
  215.     unless (s/^ *<<--//) {
  216.         print BODY &tab;
  217.     }
  218.     print BODY $_, "\n";
  219.     }
  220.     $indent += $indmod;
  221.     $indmod = 0;
  222.     if ($redo) {
  223.     $_ = $redo;
  224.     $redo = '';
  225.     redo LINE;
  226.     }
  227. }
  228. if ($lastlinewaslabel++) {
  229.     $indent += 4;
  230.     print BODY &tab, ";\n";
  231.     $indent -= 4;
  232. }
  233.  
  234. if ($appendseen || $tseen || !$assumen) {
  235.     $printit++ if $dseen || (!$assumen && !$assumep);
  236.     print BODY &q(<<'EOT');
  237. :    #ifdef SAWNEXT
  238. :    }
  239. :    continue {
  240. :    #endif
  241. :    #ifdef PRINTIT
  242. :    #ifdef DSEEN
  243. :    #ifdef ASSUMEP
  244. :        print if $printit++;
  245. :    #else
  246. :        if ($printit)
  247. :        { print; }
  248. :        else
  249. :        { $printit++ unless $nflag; }
  250. :    #endif
  251. :    #else
  252. :        print if $printit;
  253. :    #endif
  254. :    #else
  255. :        print;
  256. :    #endif
  257. :    #ifdef TSEEN
  258. :        $tflag = 0;
  259. :    #endif
  260. :    #ifdef APPENDSEEN
  261. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  262. :    #endif
  263. EOT
  264.  
  265. print BODY &q(<<'EOT');
  266. :    }
  267. EOT
  268. }
  269.  
  270. close BODY;
  271.  
  272. unless ($debug) {
  273.     open(HEAD,">/tmp/sperl2$$.c")
  274.       || &Die("Can't open temp file 2: $!\n");
  275.     print HEAD "#define PRINTIT\n"    if $printit;
  276.     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  277.     print HEAD "#define TSEEN\n"    if $tseen;
  278.     print HEAD "#define DSEEN\n"    if $dseen;
  279.     print HEAD "#define ASSUMEN\n"    if $assumen;
  280.     print HEAD "#define ASSUMEP\n"    if $assumep;
  281.     print HEAD "#define TOPLABEL\n"    if $toplabel;
  282.     print HEAD "#define SAWNEXT\n"    if $sawnext;
  283.     if ($opens) {print HEAD "$opens\n";}
  284.     open(BODY,"/tmp/sperl$$")
  285.       || &Die("Can't reopen temp file: $!\n");
  286.     while (<BODY>) {
  287.     print HEAD $_;
  288.     }
  289.     close HEAD;
  290.  
  291.     print &q(<<"EOT");
  292. :    #!$bin/perl
  293. :    eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  294. :        if \$running_under_some_shell;
  295. :
  296. EOT
  297.     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  298.     &Die("Can't reopen temp file: $!\n");
  299.     while (<BODY>) {
  300.     /^# [0-9]/ && next;
  301.     /^[ \t]*$/ && next;
  302.     s/^<><>//;
  303.     print;
  304.     }
  305. }
  306.  
  307. &Cleanup;
  308. exit;
  309.  
  310. sub Cleanup {
  311.     chdir "/tmp";
  312.     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  313. }
  314. sub Die {
  315.     &Cleanup;
  316.     die $_[0];
  317. }
  318. sub tab {
  319.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  320. }
  321. sub make_filehandle {
  322.     local($_) = $_[0];
  323.     local($fname) = $_;
  324.     if (!$seen{$fname}) {
  325.     $_ = "FH_" . $_ if /^\d/;
  326.     s/[^a-zA-Z0-9]/_/g;
  327.     s/^_*//;
  328.     $_ = "\U$_";
  329.     if ($fhseen{$_}) {
  330.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  331.         $_ .= $tmp;
  332.     }
  333.     $fhseen{$_} = 1;
  334.     $opens .= &q(<<"EOT");
  335. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  336. EOT
  337.     $seen{$fname} = $_;
  338.     }
  339.     $seen{$fname};
  340. }
  341.  
  342. sub make_label {
  343.     local($label) = @_;
  344.     $label =~ s/[^a-zA-Z0-9]/_/g;
  345.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  346.     $label = substr($label,0,8);
  347.  
  348.     # Could be a reserved word, so capitalize it.
  349.     substr($label,0,1) =~ y/a-z/A-Z/
  350.       if $label =~ /^[a-z]/;
  351.  
  352.     $label;
  353. }
  354.  
  355. sub transmogrify {
  356.     {    # case
  357.     if (/^d/) {
  358.         $dseen++;
  359.         chop($_ = &q(<<'EOT'));
  360. :    <<--#ifdef PRINTIT
  361. :    $printit = 0;
  362. :    <<--#endif
  363. :    next LINE;
  364. EOT
  365.         $sawnext++;
  366.         next;
  367.     }
  368.  
  369.     if (/^n/) {
  370.         chop($_ = &q(<<'EOT'));
  371. :    <<--#ifdef PRINTIT
  372. :    <<--#ifdef DSEEN
  373. :    <<--#ifdef ASSUMEP
  374. :    print if $printit++;
  375. :    <<--#else
  376. :    if ($printit)
  377. :        { print; }
  378. :    else
  379. :        { $printit++ unless $nflag; }
  380. :    <<--#endif
  381. :    <<--#else
  382. :    print if $printit;
  383. :    <<--#endif
  384. :    <<--#else
  385. :    print;
  386. :    <<--#endif
  387. :    <<--#ifdef APPENDSEEN
  388. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  389. :    <<--#endif
  390. :    $_ = <>;
  391. :    chop;
  392. :    <<--#ifdef TSEEN
  393. :    $tflag = 0;
  394. :    <<--#endif
  395. EOT
  396.         next;
  397.     }
  398.  
  399.     if (/^a/) {
  400.         $appendseen++;
  401.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  402.         $lastline = 0;
  403.         while (<>) {
  404.         s/^[ \t]*//;
  405.         s/^[\\]//;
  406.         unless (s|\\$||) { $lastline = 1;}
  407.         s/^([ \t]*\n)/<><>$1/;
  408.         $command .= $_;
  409.         $command .= '<<--';
  410.         last if $lastline;
  411.         }
  412.         $_ = $command . "End_Of_Text";
  413.         last;
  414.     }
  415.  
  416.     if (/^[ic]/) {
  417.         if (/^c/) { $change = 1; }
  418.         $addr1 = 1 if $addr1 eq '';
  419.         $addr1 = '$iter = (' . $addr1 . ')';
  420.         $command = $space .
  421.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  422.         $lastline = 0;
  423.         while (<>) {
  424.         s/^[ \t]*//;
  425.         s/^[\\]//;
  426.         unless (s/\\$//) { $lastline = 1;}
  427.         s/'/\\'/g;
  428.         s/^([ \t]*\n)/<><>$1/;
  429.         $command .= $_;
  430.         $command .= '<<--';
  431.         last if $lastline;
  432.         }
  433.         $_ = $command . "End_Of_Text";
  434.         if ($change) {
  435.         $dseen++;
  436.         $change = "$_\n";
  437.         chop($_ = &q(<<"EOT"));
  438. :    <<--#ifdef PRINTIT
  439. :    $space\$printit = 0;
  440. :    <<--#endif
  441. :    ${space}next LINE;
  442. EOT
  443.         $sawnext++;
  444.         }
  445.         last;
  446.     }
  447.  
  448.     if (/^s/) {
  449.         $delim = substr($_,1,1);
  450.         $len = length($_);
  451.         $repl = $end = 0;
  452.         $inbracket = 0;
  453.         for ($i = 2; $i < $len; $i++) {
  454.         $c = substr($_,$i,1);
  455.         if ($c eq $delim) {
  456.             if ($inbracket) {
  457.             substr($_, $i, 0) = '\\';
  458.             $i++;
  459.             $len++;
  460.             }
  461.             else {
  462.             if ($repl) {
  463.                 $end = $i;
  464.                 last;
  465.             } else {
  466.                 $repl = $i;
  467.             }
  468.             }
  469.         }
  470.         elsif ($c eq '\\') {
  471.             $i++;
  472.             if ($i >= $len) {
  473.             $_ .= 'n';
  474.             $_ .= <>;
  475.             $len = length($_);
  476.             $_ = substr($_,0,--$len);
  477.             }
  478.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  479.             ;
  480.             }
  481.             elsif (!$repl &&
  482.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  483.             $i--;
  484.             $len--;
  485.             substr($_, $i, 1) = '';
  486.             }
  487.             elsif (!$repl &&
  488.               substr($_,$i,1) =~ /^[<>]$/) {
  489.             substr($_,$i,1) = 'b';
  490.             }
  491.         }
  492.         elsif ($c eq '[' && !$repl) {
  493.             $i++ if substr($_,$i,1) eq '^';
  494.             $i++ if substr($_,$i,1) eq ']';
  495.             $inbracket = 1;
  496.         }
  497.         elsif ($c eq ']') {
  498.             $inbracket = 0;
  499.         }
  500.         elsif ($c eq "\t") {
  501.             substr($_, $i, 1) = '\\t';
  502.             $i++;
  503.             $len++;
  504.         }
  505.         elsif (!$repl && index("()+",$c) >= 0) {
  506.             substr($_, $i, 0) = '\\';
  507.             $i++;
  508.             $len++;
  509.         }
  510.         }
  511.         &Die("Malformed substitution at line $.\n")
  512.           unless $end;
  513.         $pat = substr($_, 0, $repl + 1);
  514.         $repl = substr($_, $repl+1, $end-$repl-1);
  515.         $end = substr($_, $end + 1, 1000);
  516.         &simplify($pat);
  517.         $dol = '$';
  518.         $repl =~ s/\$/\\$/;
  519.         $repl =~ s'&'$&'g;
  520.         $repl =~ s/[\\]([0-9])/$dol$1/g;
  521.         $subst = "$pat$repl$delim";
  522.         $cmd = '';
  523.         while ($end) {
  524.         if ($end =~ s/^g//) {
  525.             $subst .= 'g';
  526.             next;
  527.         }
  528.         if ($end =~ s/^p//) {
  529.             $cmd .= ' && (print)';
  530.             next;
  531.         }
  532.         if ($end =~ s/^w[ \t]*//) {
  533.             $fh = &make_filehandle($end);
  534.             $cmd .= " && (print $fh \$_)";
  535.             $end = '';
  536.             next;
  537.         }
  538.         &Die("Unrecognized substitution command".
  539.           "($end) at line $.\n");
  540.         }
  541.         chop ($_ = &q(<<"EOT"));
  542. :    <<--#ifdef TSEEN
  543. :    $subst && \$tflag++$cmd;
  544. :    <<--#else
  545. :    $subst$cmd;
  546. :    <<--#endif
  547. EOT
  548.         next;
  549.     }
  550.  
  551.     if (/^p/) {
  552.         $_ = 'print;';
  553.         next;
  554.     }
  555.  
  556.     if (/^w/) {
  557.         s/^w[ \t]*//;
  558.         $fh = &make_filehandle($_);
  559.         $_ = "print $fh \$_;";
  560.         next;
  561.     }
  562.  
  563.     if (/^r/) {
  564.         $appendseen++;
  565.         s/^r[ \t]*//;
  566.         $file = $_;
  567.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  568.         next;
  569.     }
  570.  
  571.     if (/^P/) {
  572.         $_ = 'print $1 if /^(.*)/;';
  573.         next;
  574.     }
  575.  
  576.     if (/^D/) {
  577.         chop($_ = &q(<<'EOT'));
  578. :    s/^.*\n?//;
  579. :    redo LINE if $_;
  580. :    next LINE;
  581. EOT
  582.         $sawnext++;
  583.         next;
  584.     }
  585.  
  586.     if (/^N/) {
  587.         chop($_ = &q(<<'EOT'));
  588. :    $_ .= "\n";
  589. :    $len1 = length;
  590. :    $_ .= <>;
  591. :    chop if $len1 < length;
  592. :    <<--#ifdef TSEEN
  593. :    $tflag = 0;
  594. :    <<--#endif
  595. EOT
  596.         next;
  597.     }
  598.  
  599.     if (/^h/) {
  600.         $_ = '$hold = $_;';
  601.         next;
  602.     }
  603.  
  604.     if (/^H/) {
  605.         $_ = '$hold .= "\n"; $hold .= $_;';
  606.         next;
  607.     }
  608.  
  609.     if (/^g/) {
  610.         $_ = '$_ = $hold;';
  611.         next;
  612.     }
  613.  
  614.     if (/^G/) {
  615.         $_ = '$_ .= "\n"; $_ .= $hold;';
  616.         next;
  617.     }
  618.  
  619.     if (/^x/) {
  620.         $_ = '($_, $hold) = ($hold, $_);';
  621.         next;
  622.     }
  623.  
  624.     if (/^b$/) {
  625.         $_ = 'next LINE;';
  626.         $sawnext++;
  627.         next;
  628.     }
  629.  
  630.     if (/^b/) {
  631.         s/^b[ \t]*//;
  632.         $lab = &make_label($_);
  633.         if ($lab eq $toplabel) {
  634.         $_ = 'redo LINE;';
  635.         } else {
  636.         $_ = "goto $lab;";
  637.         }
  638.         next;
  639.     }
  640.  
  641.     if (/^t$/) {
  642.         $_ = 'next LINE if $tflag;';
  643.         $sawnext++;
  644.         $tseen++;
  645.         next;
  646.     }
  647.  
  648.     if (/^t/) {
  649.         s/^t[ \t]*//;
  650.         $lab = &make_label($_);
  651.         $_ = q/if ($tflag) {$tflag = 0; /;
  652.         if ($lab eq $toplabel) {
  653.         $_ .= 'redo LINE;}';
  654.         } else {
  655.         $_ .= "goto $lab;}";
  656.         }
  657.         $tseen++;
  658.         next;
  659.     }
  660.  
  661.     if (/^y/) {
  662.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  663.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  664.         s/abcdef/a-f/g;
  665.         s/ABCDEF/A-F/g;
  666.         s/0123456789/0-9/g;
  667.         s/01234567/0-7/g;
  668.         $_ .= ';';
  669.     }
  670.  
  671.     if (/^=/) {
  672.         $_ = 'print $.;';
  673.         next;
  674.     }
  675.  
  676.     if (/^q/) {
  677.         chop($_ = &q(<<'EOT'));
  678. :    close(ARGV);
  679. :    @ARGV = ();
  680. :    next LINE;
  681. EOT
  682.         $sawnext++;
  683.         next;
  684.     }
  685.     } continue {
  686.     if ($space) {
  687.         s/^/$space/;
  688.         s/(\n)(.)/$1$space$2/g;
  689.     }
  690.     last;
  691.     }
  692.     $_;
  693. }
  694.  
  695. sub fetchpat {
  696.     local($outer) = @_;
  697.     local($addr) = $outer;
  698.     local($inbracket);
  699.     local($prefix,$delim,$ch);
  700.  
  701.     # Process pattern one potential delimiter at a time.
  702.  
  703.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  704.     $prefix = $1;
  705.     $delim = $2;
  706.     if ($delim eq '\\') {
  707.         s/(.)//;
  708.         $ch = $1;
  709.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  710.         $ch = 'b' if $ch =~ /^[<>]$/;
  711.         $delim .= $ch;
  712.     }
  713.     elsif ($delim eq '[') {
  714.         $inbracket = 1;
  715.         s/^\^// && ($delim .= '^');
  716.         s/^]// && ($delim .= ']');
  717.     }
  718.     elsif ($delim eq ']') {
  719.         $inbracket = 0;
  720.     }
  721.     elsif ($inbracket || $delim ne $outer) {
  722.         $delim = '\\' . $delim;
  723.     }
  724.     $addr .= $prefix;
  725.     $addr .= $delim;
  726.     if ($delim eq $outer && !$inbracket) {
  727.         last DELIM;
  728.     }
  729.     }
  730.     $addr =~ s/\t/\\t/g;
  731.     &simplify($addr);
  732.     $addr;
  733. }
  734.  
  735. sub q {
  736.     local($string) = @_;
  737.     local($*) = 1;
  738.     $string =~ s/^:\t?//g;
  739.     $string;
  740. }
  741.  
  742. sub simplify {
  743.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  744.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  745.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  746.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  747.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  748.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  749.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  750.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  751.     $_[0] =~ s/\[\\w\]/\\w/g;
  752.     $_[0] =~ s/\[^\\w\]/\\W/g;
  753.     $_[0] =~ s/\[0-9\]/\\d/g;
  754.     $_[0] =~ s/\[^0-9\]/\\D/g;
  755.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  756.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  757.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  758.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  759.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  760.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  761. }
  762.  
  763. !NO!SUBS!
  764. chmod 755 s2p
  765. $eunicefix s2p
  766.