home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / perl4036.zip / x2p / s2p.SH < prev    next >
Text File  |  1993-02-08  |  15KB  |  790 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. 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
  790.