[p5sagit/p5-mst-13.2.git] / x2p / s2p.SH

: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
case $CONFIG in
'')
    if test ! -f config.sh; then
	ln ../config.sh . || \
	ln -s ../config.sh . || \
	ln ../../config.sh . || \
	ln ../../../config.sh . || \
	(echo "Can't find config.sh."; exit 1)
    fi 2>/dev/null
    . ./config.sh
    ;;
esac
echo "Extracting s2p (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front.  You may delete these comments.
rm -f s2p
$spitshell >s2p <<!GROK!THIS!
#!$bin/perl

eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;

\$bin = '$bin';
!GROK!THIS!

: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'

# $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
#
# $Log:	s2p.SH,v $
# Revision 4.1  92/08/07  18:29:23  lwall
# 
# Revision 4.0.1.2  92/06/08  17:26:31  lwall
# patch20: s2p didn't output portable startup code
# patch20: added ... as variant on ..
# patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
# 
# Revision 4.0.1.1  91/06/07  12:19:18  lwall
# patch4: s2p now handles embedded newlines better and optimizes common idioms
# 
# Revision 4.0  91/03/20  01:57:59  lwall
# 4.0 baseline.
# 
#

$indent = 4;
$shiftwidth = 4;
$l = '{'; $r = '}';

while ($ARGV[0] =~ /^-/) {
    $_ = shift;
  last if /^--/;
    if (/^-D/) {
	$debug++;
	open(BODY,'>-');
	next;
    }
    if (/^-n/) {
	$assumen++;
	next;
    }
    if (/^-p/) {
	$assumep++;
	next;
    }
    die "I don't recognize this switch: $_\n";
}

unless ($debug) {
    open(BODY,">/tmp/sperl$$") ||
      &Die("Can't open temp file: $!\n");
}

if (!$assumen && !$assumep) {
    print BODY &q(<<'EOT');
:	while ($ARGV[0] =~ /^-/) {
:	    $_ = shift;
:	  last if /^--/;
:	    if (/^-n/) {
:		$nflag++;
:		next;
:	    }
:	    die "I don't recognize this switch: $_\\n";
:	}
:	
EOT
}

print BODY &q(<<'EOT');
:	#ifdef PRINTIT
:	#ifdef ASSUMEP
:	$printit++;
:	#else
:	$printit++ unless $nflag;
:	#endif
:	#endif
:	<><>
:	$\ = "\n";		# automatically add newline on print
:	<><>
:	#ifdef TOPLABEL
:	LINE:
:	while (chop($_ = <>)) {
:	#else
:	LINE:
:	while (<>) {
:	    chop;
:	#endif
EOT

LINE:
while (<>) {

    # Wipe out surrounding whitespace.

    s/[ \t]*(.*)\n$/$1/;

    # Perhaps it's a label/comment.

    if (/^:/) {
	s/^:[ \t]*//;
	$label = &make_label($_);
	if ($. == 1) {
	    $toplabel = $label;
	    if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
		$_ = <>;
		redo LINE; # Never referenced, so delete it if not a comment.
	    }
	}
	$_ = "$label:";
	if ($lastlinewaslabel++) {
	    $indent += 4;
	    print BODY &tab, ";\n";
	    $indent -= 4;
	}
	if ($indent >= 2) {
	    $indent -= 2;
	    $indmod = 2;
	}
	next;
    } else {
	$lastlinewaslabel = '';
    }

    # Look for one or two address clauses

    $addr1 = '';
    $addr2 = '';
    if (s/^([0-9]+)//) {
	$addr1 = "$1";
	$addr1 = "\$. == $addr1" unless /^,/;
    }
    elsif (s/^\$//) {
	$addr1 = 'eof()';
    }
    elsif (s|^/||) {
	$addr1 = &fetchpat('/');
    }
    if (s/^,//) {
	if (s/^([0-9]+)//) {
	    $addr2 = "$1";
	} elsif (s/^\$//) {
	    $addr2 = "eof()";
	} elsif (s|^/||) {
	    $addr2 = &fetchpat('/');
	} else {
	    &Die("Invalid second address at line $.\n");
	}
	if ($addr2 =~ /^\d+$/) {
	    $addr1 .= "..$addr2";
	}
	else {
	    $addr1 .= "...$addr2";
	}
    }

    # Now we check for metacommands {, }, and ! and worry
    # about indentation.

    s/^[ \t]+//;
    # a { to keep vi happy
    if ($_ eq '}') {
	$indent -= 4;
	next;
    }
    if (s/^!//) {
	$if = 'unless';
	$else = "$r else $l\n";
    } else {
	$if = 'if';
	$else = '';
    }
    if (s/^{//) {	# a } to keep vi happy
	$indmod = 4;
	$redo = $_;
	$_ = '';
	$rmaybe = '';
    } else {
	$rmaybe = "\n$r";
	if ($addr2 || $addr1) {
	    $space = ' ' x $shiftwidth;
	} else {
	    $space = '';
	}
	$_ = &transmogrify();
    }

    # See if we can optimize to modifier form.

    if ($addr1) {
	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
	  $_ !~ / if / && $_ !~ / unless /) {
	    s/;$/ $if $addr1;/;
	    $_ = substr($_,$shiftwidth,1000);
	} else {
	    $_ = "$if ($addr1) $l\n$change$_$rmaybe";
	}
	$change = '';
	next LINE;
    }
} continue {
    @lines = split(/\n/,$_);
    for (@lines) {
	unless (s/^ *<<--//) {
	    print BODY &tab;
	}
	print BODY $_, "\n";
    }
    $indent += $indmod;
    $indmod = 0;
    if ($redo) {
	$_ = $redo;
	$redo = '';
	redo LINE;
    }
}
if ($lastlinewaslabel++) {
    $indent += 4;
    print BODY &tab, ";\n";
    $indent -= 4;
}

if ($appendseen || $tseen || !$assumen) {
    $printit++ if $dseen || (!$assumen && !$assumep);
    print BODY &q(<<'EOT');
:	#ifdef SAWNEXT
:	}
:	continue {
:	#endif
:	#ifdef PRINTIT
:	#ifdef DSEEN
:	#ifdef ASSUMEP
:	    print if $printit++;
:	#else
:	    if ($printit)
:		{ print; }
:	    else
:		{ $printit++ unless $nflag; }
:	#endif
:	#else
:	    print if $printit;
:	#endif
:	#else
:	    print;
:	#endif
:	#ifdef TSEEN
:	    $tflag = 0;
:	#endif
:	#ifdef APPENDSEEN
:	    if ($atext) { chop $atext; print $atext; $atext = ''; }
:	#endif
EOT

print BODY &q(<<'EOT');
:	}
EOT
}

close BODY;

unless ($debug) {
    open(HEAD,">/tmp/sperl2$$.c")
      || &Die("Can't open temp file 2: $!\n");
    print HEAD "#define PRINTIT\n"	if $printit;
    print HEAD "#define APPENDSEEN\n"	if $appendseen;
    print HEAD "#define TSEEN\n"	if $tseen;
    print HEAD "#define DSEEN\n"	if $dseen;
    print HEAD "#define ASSUMEN\n"	if $assumen;
    print HEAD "#define ASSUMEP\n"	if $assumep;
    print HEAD "#define TOPLABEL\n"	if $toplabel;
    print HEAD "#define SAWNEXT\n"	if $sawnext;
    if ($opens) {print HEAD "$opens\n";}
    open(BODY,"/tmp/sperl$$")
      || &Die("Can't reopen temp file: $!\n");
    while (<BODY>) {
	print HEAD $_;
    }
    close HEAD;

    print &q(<<"EOT");
:	#!$bin/perl
:	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
:		if \$running_under_some_shell;
:	
EOT
    open(BODY,"cc -E /tmp/sperl2$$.c |") ||
	&Die("Can't reopen temp file: $!\n");
    while (<BODY>) {
	/^# [0-9]/ && next;
	/^[ \t]*$/ && next;
	s/^<><>//;
	print;
    }
}

&Cleanup;
exit;

sub Cleanup {
    chdir "/tmp";
    unlink "sperl$$", "sperl2$$", "sperl2$$.c";
}
sub Die {
    &Cleanup;
    die $_[0];
}
sub tab {
    "\t" x ($indent / 8) . ' ' x ($indent % 8);
}
sub make_filehandle {
    local($_) = $_[0];
    local($fname) = $_;
    if (!$seen{$fname}) {
	$_ = "FH_" . $_ if /^\d/;
	s/[^a-zA-Z0-9]/_/g;
	s/^_*//;
	$_ = "\U$_";
	if ($fhseen{$_}) {
	    for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
	    $_ .= $tmp;
	}
	$fhseen{$_} = 1;
	$opens .= &q(<<"EOT");
:	open($_, '>$fname') || die "Can't create $fname: \$!";
EOT
	$seen{$fname} = $_;
    }
    $seen{$fname};
}

sub make_label {
    local($label) = @_;
    $label =~ s/[^a-zA-Z0-9]/_/g;
    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
    $label = substr($label,0,8);

    # Could be a reserved word, so capitalize it.
    substr($label,0,1) =~ y/a-z/A-Z/
      if $label =~ /^[a-z]/;

    $label;
}

sub transmogrify {
    {	# case
	if (/^d/) {
	    $dseen++;
	    chop($_ = &q(<<'EOT'));
:	<<--#ifdef PRINTIT
:	$printit = 0;
:	<<--#endif
:	next LINE;
EOT
	    $sawnext++;
	    next;
	}

	if (/^n/) {
	    chop($_ = &q(<<'EOT'));
:	<<--#ifdef PRINTIT
:	<<--#ifdef DSEEN
:	<<--#ifdef ASSUMEP
:	print if $printit++;
:	<<--#else
:	if ($printit)
:	    { print; }
:	else
:	    { $printit++ unless $nflag; }
:	<<--#endif
:	<<--#else
:	print if $printit;
:	<<--#endif
:	<<--#else
:	print;
:	<<--#endif
:	<<--#ifdef APPENDSEEN
:	if ($atext) {chop $atext; print $atext; $atext = '';}
:	<<--#endif
:	$_ = <>;
:	chop;
:	<<--#ifdef TSEEN
:	$tflag = 0;
:	<<--#endif
EOT
	    next;
	}

	if (/^a/) {
	    $appendseen++;
	    $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
	    $lastline = 0;
	    while (<>) {
		s/^[ \t]*//;
		s/^[\\]//;
		unless (s|\\$||) { $lastline = 1;}
		s/^([ \t]*\n)/<><>$1/;
		$command .= $_;
		$command .= '<<--';
		last if $lastline;
	    }
	    $_ = $command . "End_Of_Text";
	    last;
	}

	if (/^[ic]/) {
	    if (/^c/) { $change = 1; }
	    $addr1 = 1 if $addr1 eq '';
	    $addr1 = '$iter = (' . $addr1 . ')';
	    $command = $space .
	      "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
	    $lastline = 0;
	    while (<>) {
		s/^[ \t]*//;
		s/^[\\]//;
		unless (s/\\$//) { $lastline = 1;}
		s/'/\\'/g;
		s/^([ \t]*\n)/<><>$1/;
		$command .= $_;
		$command .= '<<--';
		last if $lastline;
	    }
	    $_ = $command . "End_Of_Text";
	    if ($change) {
		$dseen++;
		$change = "$_\n";
		chop($_ = &q(<<"EOT"));
:	<<--#ifdef PRINTIT
:	$space\$printit = 0;
:	<<--#endif
:	${space}next LINE;
EOT
		$sawnext++;
	    }
	    last;
	}

	if (/^s/) {
	    $delim = substr($_,1,1);
	    $len = length($_);
	    $repl = $end = 0;
	    $inbracket = 0;
	    for ($i = 2; $i < $len; $i++) {
		$c = substr($_,$i,1);
		if ($c eq $delim) {
		    if ($inbracket) {
			substr($_, $i, 0) = '\\';
			$i++;
			$len++;
		    }
		    else {
			if ($repl) {
			    $end = $i;
			    last;
			} else {
			    $repl = $i;
			}
		    }
		}
		elsif ($c eq '\\') {
		    $i++;
		    if ($i >= $len) {
			$_ .= 'n';
			$_ .= <>;
			$len = length($_);
			$_ = substr($_,0,--$len);
		    }
		    elsif (substr($_,$i,1) =~ /^[n]$/) {
			;
		    }
		    elsif (!$repl &&
		      substr($_,$i,1) =~ /^[(){}\w]$/) {
			$i--;
			$len--;
			substr($_, $i, 1) = '';
		    }
		    elsif (!$repl &&
		      substr($_,$i,1) =~ /^[<>]$/) {
			substr($_,$i,1) = 'b';
		    }
		    elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
			substr($_,$i-1,1) = '$';
		    }
		}
		elsif ($c eq '&' && $repl) {
		    substr($_, $i, 0) = '$';
		    $i++;
		    $len++;
		}
		elsif ($c eq '$' && $repl) {
		    substr($_, $i, 0) = '\\';
		    $i++;
		    $len++;
		}
		elsif ($c eq '[' && !$repl) {
		    $i++ if substr($_,$i,1) eq '^';
		    $i++ if substr($_,$i,1) eq ']';
		    $inbracket = 1;
		}
		elsif ($c eq ']') {
		    $inbracket = 0;
		}
		elsif ($c eq "\t") {
		    substr($_, $i, 1) = '\\t';
		    $i++;
		    $len++;
		}
		elsif (!$repl && index("()+",$c) >= 0) {
		    substr($_, $i, 0) = '\\';
		    $i++;
		    $len++;
		}
	    }
	    &Die("Malformed substitution at line $.\n")
	      unless $end;
	    $pat = substr($_, 0, $repl + 1);
	    $repl = substr($_, $repl+1, $end-$repl-1);
	    $end = substr($_, $end + 1, 1000);
	    &simplify($pat);
	    $dol = '$';
	    $subst = "$pat$repl$delim";
	    $cmd = '';
	    while ($end) {
		if ($end =~ s/^g//) {
		    $subst .= 'g';
		    next;
		}
		if ($end =~ s/^p//) {
		    $cmd .= ' && (print)';
		    next;
		}
		if ($end =~ s/^w[ \t]*//) {
		    $fh = &make_filehandle($end);
		    $cmd .= " && (print $fh \$_)";
		    $end = '';
		    next;
		}
		&Die("Unrecognized substitution command".
		  "($end) at line $.\n");
	    }
	    chop ($_ = &q(<<"EOT"));
:	<<--#ifdef TSEEN
:	$subst && \$tflag++$cmd;
:	<<--#else
:	$subst$cmd;
:	<<--#endif
EOT
	    next;
	}

	if (/^p/) {
	    $_ = 'print;';
	    next;
	}

	if (/^w/) {
	    s/^w[ \t]*//;
	    $fh = &make_filehandle($_);
	    $_ = "print $fh \$_;";
	    next;
	}

	if (/^r/) {
	    $appendseen++;
	    s/^r[ \t]*//;
	    $file = $_;
	    $_ = "\$atext .= `cat $file 2>/dev/null`;";
	    next;
	}

	if (/^P/) {
	    $_ = 'print $1 if /^(.*)/;';
	    next;
	}

	if (/^D/) {
	    chop($_ = &q(<<'EOT'));
:	s/^.*\n?//;
:	redo LINE if $_;
:	next LINE;
EOT
	    $sawnext++;
	    next;
	}

	if (/^N/) {
	    chop($_ = &q(<<'EOT'));
:	$_ .= "\n";
:	$len1 = length;
:	$_ .= <>;
:	chop if $len1 < length;
:	<<--#ifdef TSEEN
:	$tflag = 0;
:	<<--#endif
EOT
	    next;
	}

	if (/^h/) {
	    $_ = '$hold = $_;';
	    next;
	}

	if (/^H/) {
	    $_ = '$hold .= "\n"; $hold .= $_;';
	    next;
	}

	if (/^g/) {
	    $_ = '$_ = $hold;';
	    next;
	}

	if (/^G/) {
	    $_ = '$_ .= "\n"; $_ .= $hold;';
	    next;
	}

	if (/^x/) {
	    $_ = '($_, $hold) = ($hold, $_);';
	    next;
	}

	if (/^b$/) {
	    $_ = 'next LINE;';
	    $sawnext++;
	    next;
	}

	if (/^b/) {
	    s/^b[ \t]*//;
	    $lab = &make_label($_);
	    if ($lab eq $toplabel) {
		$_ = 'redo LINE;';
	    } else {
		$_ = "goto $lab;";
	    }
	    next;
	}

	if (/^t$/) {
	    $_ = 'next LINE if $tflag;';
	    $sawnext++;
	    $tseen++;
	    next;
	}

	if (/^t/) {
	    s/^t[ \t]*//;
	    $lab = &make_label($_);
	    $_ = q/if ($tflag) {$tflag = 0; /;
	    if ($lab eq $toplabel) {
		$_ .= 'redo LINE;}';
	    } else {
		$_ .= "goto $lab;}";
	    }
	    $tseen++;
	    next;
	}

	if (/^y/) {
	    s/abcdefghijklmnopqrstuvwxyz/a-z/g;
	    s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
	    s/abcdef/a-f/g;
	    s/ABCDEF/A-F/g;
	    s/0123456789/0-9/g;
	    s/01234567/0-7/g;
	    $_ .= ';';
	}

	if (/^=/) {
	    $_ = 'print $.;';
	    next;
	}

	if (/^q/) {
	    chop($_ = &q(<<'EOT'));
:	close(ARGV);
:	@ARGV = ();
:	next LINE;
EOT
	    $sawnext++;
	    next;
	}
    } continue {
	if ($space) {
	    s/^/$space/;
	    s/(\n)(.)/$1$space$2/g;
	}
	last;
    }
    $_;
}

sub fetchpat {
    local($outer) = @_;
    local($addr) = $outer;
    local($inbracket);
    local($prefix,$delim,$ch);

    # Process pattern one potential delimiter at a time.

    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
	$prefix = $1;
	$delim = $2;
	if ($delim eq '\\') {
	    s/(.)//;
	    $ch = $1;
	    $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
	    $ch = 'b' if $ch =~ /^[<>]$/;
	    $delim .= $ch;
	}
	elsif ($delim eq '[') {
	    $inbracket = 1;
	    s/^\^// && ($delim .= '^');
	    s/^]// && ($delim .= ']');
	}
	elsif ($delim eq ']') {
	    $inbracket = 0;
	}
	elsif ($inbracket || $delim ne $outer) {
	    $delim = '\\' . $delim;
	}
	$addr .= $prefix;
	$addr .= $delim;
	if ($delim eq $outer && !$inbracket) {
	    last DELIM;
	}
    }
    $addr =~ s/\t/\\t/g;
    &simplify($addr);
    $addr;
}

sub q {
    local($string) = @_;
    local($*) = 1;
    $string =~ s/^:\t?//g;
    $string;
}

sub simplify {
    $_[0] =~ s/_a-za-z0-9/\\w/ig;
    $_[0] =~ s/a-z_a-z0-9/\\w/ig;
    $_[0] =~ s/a-za-z_0-9/\\w/ig;
    $_[0] =~ s/a-za-z0-9_/\\w/ig;
    $_[0] =~ s/_0-9a-za-z/\\w/ig;
    $_[0] =~ s/0-9_a-za-z/\\w/ig;
    $_[0] =~ s/0-9a-z_a-z/\\w/ig;
    $_[0] =~ s/0-9a-za-z_/\\w/ig;
    $_[0] =~ s/\[\\w\]/\\w/g;
    $_[0] =~ s/\[^\\w\]/\\W/g;
    $_[0] =~ s/\[0-9\]/\\d/g;
    $_[0] =~ s/\[^0-9\]/\\D/g;
    $_[0] =~ s/\\d\\d\*/\\d+/g;
    $_[0] =~ s/\\D\\D\*/\\D+/g;
    $_[0] =~ s/\\w\\w\*/\\w+/g;
    $_[0] =~ s/\\t\\t\*/\\t+/g;
    $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
    $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
}

!NO!SUBS!
chmod 755 s2p
$eunicefix s2p
Commit	Line	Data
a687059c	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 . \|\| \
27e2fb84	10	ln -s ../config.sh . \|\| \
a687059c	11	ln ../../config.sh . \|\| \
	12	ln ../../../config.sh . \|\| \
	13	(echo "Can't find config.sh."; exit 1)
fe14fcc3	14	fi 2>/dev/null
e5d73d77	15	. ./config.sh
a687059c	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.
2b69d0c2	23	rm -f s2p
a687059c	24	$spitshell >s2p <<!GROK!THIS!
	25	#!$bin/perl
	26
2b69d0c2	27	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	28	if \$running_under_some_shell;
	29
a687059c	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
79072805	36	# $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
378cc40b	37	#
a687059c	38	# $Log: s2p.SH,v $
79072805	39	# Revision 4.1 92/08/07 18:29:23 lwall
79072805	40	#
2b69d0c2	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	#
9ef589d8	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	#
fe14fcc3	49	# Revision 4.0 91/03/20 01:57:59 lwall
fe14fcc3	50	# 4.0 baseline.
378cc40b	51	#
378cc40b	52	#
8d063cd8	53
	54	$indent = 4;
	55	$shiftwidth = 4;
	56	$l = '{'; $r = '}';
8d063cd8	57
0a12ae7d	58	while ($ARGV[0] =~ /^-/) {
8d063cd8	59	$_ = shift;
	60	last if /^--/;
	61	if (/^-D/) {
	62	$debug++;
0a12ae7d	63	open(BODY,'>-');
8d063cd8	64	next;
	65	}
	66	if (/^-n/) {
	67	$assumen++;
	68	next;
	69	}
	70	if (/^-p/) {
	71	$assumep++;
	72	next;
	73	}
378cc40b	74	die "I don't recognize this switch: $_\n";
8d063cd8	75	}
	76
	77	unless ($debug) {
0a12ae7d	78	open(BODY,">/tmp/sperl$$") \|\|
0a12ae7d	79	&Die("Can't open temp file: $!\n");
8d063cd8	80	}
	81
	82	if (!$assumen && !$assumep) {
9ef589d8	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	:
0a12ae7d	94	EOT
8d063cd8	95	}
8d063cd8	96
9ef589d8	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
0a12ae7d	116	EOT
0a12ae7d	117
9ef589d8	118	LINE:
9ef589d8	119	while (<>) {
0a12ae7d	120
0a12ae7d	121	# Wipe out surrounding whitespace.
8d063cd8	122
8d063cd8	123	s/[ \t](.)\n$/$1/;
0a12ae7d	124
	125	# Perhaps it's a label/comment.
	126
8d063cd8	127	if (/^:/) {
8d063cd8	128	s/^:[ \t]*//;
0a12ae7d	129	$label = &make_label($_);
8d063cd8	130	if ($. == 1) {
8d063cd8	131	$toplabel = $label;
9ef589d8	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	}
8d063cd8	136	}
8d063cd8	137	$_ = "$label:";
ffed7fef	138	if ($lastlinewaslabel++) {
ffed7fef	139	$indent += 4;
0a12ae7d	140	print BODY &tab, ";\n";
ffed7fef	141	$indent -= 4;
ffed7fef	142	}
8d063cd8	143	if ($indent >= 2) {
	144	$indent -= 2;
	145	$indmod = 2;
	146	}
	147	next;
	148	} else {
	149	$lastlinewaslabel = '';
	150	}
0a12ae7d	151
	152	# Look for one or two address clauses
	153
8d063cd8	154	$addr1 = '';
	155	$addr2 = '';
	156	if (s/^([0-9]+)//) {
	157	$addr1 = "$1";
9ef589d8	158	$addr1 = "\$. == $addr1" unless /^,/;
8d063cd8	159	}
	160	elsif (s/^\$//) {
	161	$addr1 = 'eof()';
	162	}
	163	elsif (s\|^/\|\|) {
0a12ae7d	164	$addr1 = &fetchpat('/');
8d063cd8	165	}
	166	if (s/^,//) {
	167	if (s/^([0-9]+)//) {
	168	$addr2 = "$1";
	169	} elsif (s/^\$//) {
	170	$addr2 = "eof()";
	171	} elsif (s\|^/\|\|) {
0a12ae7d	172	$addr2 = &fetchpat('/');
8d063cd8	173	} else {
0a12ae7d	174	&Die("Invalid second address at line $.\n");
8d063cd8	175	}
2b69d0c2	176	if ($addr2 =~ /^\d+$/) {
	177	$addr1 .= "..$addr2";
	178	}
	179	else {
	180	$addr1 .= "...$addr2";
	181	}
8d063cd8	182	}
0a12ae7d	183
	184	# Now we check for metacommands {, }, and ! and worry
	185	# about indentation.
	186
378cc40b	187	s/^[ \t]+//;
0a12ae7d	188	# a { to keep vi happy
8d063cd8	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) {
a687059c	208	$space = ' ' x $shiftwidth;
8d063cd8	209	} else {
	210	$space = '';
	211	}
0a12ae7d	212	$_ = &transmogrify();
8d063cd8	213	}
8d063cd8	214
0a12ae7d	215	# See if we can optimize to modifier form.
0a12ae7d	216
8d063cd8	217	if ($addr1) {
	218	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
	219	$_ !~ / if / && $_ !~ / unless /) {
	220	s/;$/ $if $addr1;/;
	221	$_ = substr($_,$shiftwidth,1000);
	222	} else {
0a12ae7d	223	$_ = "$if ($addr1) $l\n$change$_$rmaybe";
8d063cd8	224	}
8d063cd8	225	$change = '';
0a12ae7d	226	next LINE;
8d063cd8	227	}
	228	} continue {
	229	@lines = split(/\n/,$_);
0a12ae7d	230	for (@lines) {
8d063cd8	231	unless (s/^ *<<--//) {
0a12ae7d	232	print BODY &tab;
8d063cd8	233	}
0a12ae7d	234	print BODY $_, "\n";
8d063cd8	235	}
	236	$indent += $indmod;
	237	$indmod = 0;
	238	if ($redo) {
	239	$_ = $redo;
	240	$redo = '';
0a12ae7d	241	redo LINE;
8d063cd8	242	}
8d063cd8	243	}
ffed7fef	244	if ($lastlinewaslabel++) {
ffed7fef	245	$indent += 4;
0a12ae7d	246	print BODY &tab, ";\n";
ffed7fef	247	$indent -= 4;
ffed7fef	248	}
8d063cd8	249
8d063cd8	250	if ($appendseen \|\| $tseen \|\| !$assumen) {
8d063cd8	251	$printit++ if $dseen \|\| (!$assumen && !$assumep);
9ef589d8	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	: }
0a12ae7d	283	EOT
8d063cd8	284	}
8d063cd8	285
0a12ae7d	286	close BODY;
8d063cd8	287
8d063cd8	288	unless ($debug) {
0a12ae7d	289	open(HEAD,">/tmp/sperl2$$.c")
0a12ae7d	290	\|\| &Die("Can't open temp file 2: $!\n");
9ef589d8	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;
0a12ae7d	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 $_;
8d063cd8	304	}
0a12ae7d	305	close HEAD;
8d063cd8	306
9ef589d8	307	print &q(<<"EOT");
	308	: #!$bin/perl
	309	: eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	310	: if \$running_under_some_shell;
	311	:
0a12ae7d	312	EOT
	313	open(BODY,"cc -E /tmp/sperl2$$.c \|") \|\|
	314	&Die("Can't reopen temp file: $!\n");
	315	while (<BODY>) {
8d063cd8	316	/^# [0-9]/ && next;
	317	/^[ \t]*$/ && next;
	318	s/^<><>//;
	319	print;
	320	}
	321	}
	322
0a12ae7d	323	&Cleanup;
0a12ae7d	324	exit;
8d063cd8	325
0a12ae7d	326	sub Cleanup {
	327	chdir "/tmp";
	328	unlink "sperl$$", "sperl2$$", "sperl2$$.c";
	329	}
8d063cd8	330	sub Die {
0a12ae7d	331	&Cleanup;
8d063cd8	332	die $_[0];
8d063cd8	333	}
0a12ae7d	334	sub tab {
	335	"\t" x ($indent / 8) . ' ' x ($indent % 8);
	336	}
8d063cd8	337	sub make_filehandle {
0a12ae7d	338	local($_) = $_[0];
0a12ae7d	339	local($fname) = $_;
9ef589d8	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: \$!";
0a12ae7d	352	EOT
9ef589d8	353	$seen{$fname} = $_;
8d063cd8	354	}
9ef589d8	355	$seen{$fname};
8d063cd8	356	}
	357
	358	sub make_label {
0a12ae7d	359	local($label) = @_;
8d063cd8	360	$label =~ s/[^a-zA-Z0-9]/_/g;
	361	if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
	362	$label = substr($label,0,8);
0a12ae7d	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
8d063cd8	368	$label;
	369	}
	370
	371	sub transmogrify {
	372	{ # case
	373	if (/^d/) {
	374	$dseen++;
9ef589d8	375	chop($_ = &q(<<'EOT'));
	376	: <<--#ifdef PRINTIT
	377	: $printit = 0;
	378	: <<--#endif
	379	: next LINE;
0a12ae7d	380	EOT
9ef589d8	381	$sawnext++;
8d063cd8	382	next;
	383	}
	384
	385	if (/^n/) {
9ef589d8	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
0a12ae7d	411	EOT
8d063cd8	412	next;
	413	}
	414
	415	if (/^a/) {
	416	$appendseen++;
9ef589d8	417	$command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
8d063cd8	418	$lastline = 0;
	419	while (<>) {
	420	s/^[ \t]*//;
	421	s/^[\\]//;
	422	unless (s\|\\$\|\|) { $lastline = 1;}
8d063cd8	423	s/^([ \t]*\n)/<><>$1/;
	424	$command .= $_;
	425	$command .= '<<--';
	426	last if $lastline;
	427	}
9ef589d8	428	$_ = $command . "End_Of_Text";
8d063cd8	429	last;
	430	}
	431
	432	if (/^[ic]/) {
	433	if (/^c/) { $change = 1; }
9ef589d8	434	$addr1 = 1 if $addr1 eq '';
8d063cd8	435	$addr1 = '$iter = (' . $addr1 . ')';
9ef589d8	436	$command = $space .
9ef589d8	437	" if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
8d063cd8	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	}
9ef589d8	449	$_ = $command . "End_Of_Text";
8d063cd8	450	if ($change) {
	451	$dseen++;
	452	$change = "$_\n";
9ef589d8	453	chop($_ = &q(<<"EOT"));
	454	: <<--#ifdef PRINTIT
	455	: $space\$printit = 0;
	456	: <<--#endif
	457	: ${space}next LINE;
0a12ae7d	458	EOT
9ef589d8	459	$sawnext++;
8d063cd8	460	}
	461	last;
	462	}
	463
	464	if (/^s/) {
	465	$delim = substr($_,1,1);
	466	$len = length($_);
	467	$repl = $end = 0;
a687059c	468	$inbracket = 0;
8d063cd8	469	for ($i = 2; $i < $len; $i++) {
8d063cd8	470	$c = substr($_,$i,1);
a687059c	471	if ($c eq $delim) {
a687059c	472	if ($inbracket) {
0a12ae7d	473	substr($_, $i, 0) = '\\';
a687059c	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 '\\') {
8d063cd8	487	$i++;
	488	if ($i >= $len) {
	489	$_ .= 'n';
	490	$_ .= <>;
	491	$len = length($_);
	492	$_ = substr($_,0,--$len);
	493	}
00bf170e	494	elsif (substr($_,$i,1) =~ /^[n]$/) {
	495	;
	496	}
0a12ae7d	497	elsif (!$repl &&
0a12ae7d	498	substr($_,$i,1) =~ /^[(){}\w]$/) {
8d063cd8	499	$i--;
8d063cd8	500	$len--;
0a12ae7d	501	substr($_, $i, 1) = '';
8d063cd8	502	}
0a12ae7d	503	elsif (!$repl &&
0a12ae7d	504	substr($_,$i,1) =~ /^[<>]$/) {
9f68db38	505	substr($_,$i,1) = 'b';
9f68db38	506	}
2b69d0c2	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++;
8d063cd8	520	}
a687059c	521	elsif ($c eq '[' && !$repl) {
	522	$i++ if substr($_,$i,1) eq '^';
	523	$i++ if substr($_,$i,1) eq ']';
	524	$inbracket = 1;
8d063cd8	525	}
a687059c	526	elsif ($c eq ']') {
	527	$inbracket = 0;
	528	}
9ef589d8	529	elsif ($c eq "\t") {
	530	substr($_, $i, 1) = '\\t';
	531	$i++;
	532	$len++;
	533	}
ae986130	534	elsif (!$repl && index("()+",$c) >= 0) {
0a12ae7d	535	substr($_, $i, 0) = '\\';
8d063cd8	536	$i++;
	537	$len++;
	538	}
	539	}
0a12ae7d	540	&Die("Malformed substitution at line $.\n")
0a12ae7d	541	unless $end;
8d063cd8	542	$pat = substr($_, 0, $repl + 1);
0a12ae7d	543	$repl = substr($_, $repl+1, $end-$repl-1);
8d063cd8	544	$end = substr($_, $end + 1, 1000);
9ef589d8	545	&simplify($pat);
8d063cd8	546	$dol = '$';
8d063cd8	547	$subst = "$pat$repl$delim";
	548	$cmd = '';
	549	while ($end) {
0a12ae7d	550	if ($end =~ s/^g//) {
	551	$subst .= 'g';
	552	next;
	553	}
	554	if ($end =~ s/^p//) {
	555	$cmd .= ' && (print)';
	556	next;
	557	}
8d063cd8	558	if ($end =~ s/^w[ \t]*//) {
0a12ae7d	559	$fh = &make_filehandle($end);
8d063cd8	560	$cmd .= " && (print $fh \$_)";
	561	$end = '';
	562	next;
	563	}
0a12ae7d	564	&Die("Unrecognized substitution command".
0a12ae7d	565	"($end) at line $.\n");
8d063cd8	566	}
9ef589d8	567	chop ($_ = &q(<<"EOT"));
	568	: <<--#ifdef TSEEN
	569	: $subst && \$tflag++$cmd;
	570	: <<--#else
	571	: $subst$cmd;
	572	: <<--#endif
0a12ae7d	573	EOT
8d063cd8	574	next;
	575	}
	576
	577	if (/^p/) {
	578	$_ = 'print;';
	579	next;
	580	}
	581
	582	if (/^w/) {
	583	s/^w[ \t]*//;
0a12ae7d	584	$fh = &make_filehandle($_);
8d063cd8	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/) {
9ef589d8	598	$_ = 'print $1 if /^(.*)/;';
8d063cd8	599	next;
	600	}
	601
	602	if (/^D/) {
9ef589d8	603	chop($_ = &q(<<'EOT'));
	604	: s/^.*\n?//;
	605	: redo LINE if $_;
	606	: next LINE;
0a12ae7d	607	EOT
9ef589d8	608	$sawnext++;
8d063cd8	609	next;
	610	}
	611
	612	if (/^N/) {
9ef589d8	613	chop($_ = &q(<<'EOT'));
	614	: $_ .= "\n";
	615	: $len1 = length;
	616	: $_ .= <>;
	617	: chop if $len1 < length;
	618	: <<--#ifdef TSEEN
	619	: $tflag = 0;
	620	: <<--#endif
0a12ae7d	621	EOT
8d063cd8	622	next;
	623	}
	624
	625	if (/^h/) {
	626	$_ = '$hold = $_;';
	627	next;
	628	}
	629
	630	if (/^H/) {
9ef589d8	631	$_ = '$hold .= "\n"; $hold .= $_;';
8d063cd8	632	next;
	633	}
	634
	635	if (/^g/) {
	636	$_ = '$_ = $hold;';
	637	next;
	638	}
	639
	640	if (/^G/) {
9ef589d8	641	$_ = '$_ .= "\n"; $_ .= $hold;';
8d063cd8	642	next;
	643	}
	644
	645	if (/^x/) {
	646	$_ = '($_, $hold) = ($hold, $_);';
	647	next;
	648	}
	649
	650	if (/^b$/) {
0a12ae7d	651	$_ = 'next LINE;';
9ef589d8	652	$sawnext++;
8d063cd8	653	next;
	654	}
	655
	656	if (/^b/) {
	657	s/^b[ \t]*//;
0a12ae7d	658	$lab = &make_label($_);
8d063cd8	659	if ($lab eq $toplabel) {
0a12ae7d	660	$_ = 'redo LINE;';
8d063cd8	661	} else {
	662	$_ = "goto $lab;";
	663	}
	664	next;
	665	}
	666
	667	if (/^t$/) {
0a12ae7d	668	$_ = 'next LINE if $tflag;';
9ef589d8	669	$sawnext++;
8d063cd8	670	$tseen++;
	671	next;
	672	}
	673
	674	if (/^t/) {
	675	s/^t[ \t]*//;
0a12ae7d	676	$lab = &make_label($_);
9ef589d8	677	$_ = q/if ($tflag) {$tflag = 0; /;
8d063cd8	678	if ($lab eq $toplabel) {
0a12ae7d	679	$_ .= 'redo LINE;}';
8d063cd8	680	} else {
0a12ae7d	681	$_ .= "goto $lab;}";
8d063cd8	682	}
	683	$tseen++;
	684	next;
	685	}
	686
9ef589d8	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
8d063cd8	697	if (/^=/) {
9ef589d8	698	$_ = 'print $.;';
8d063cd8	699	next;
	700	}
	701
	702	if (/^q/) {
9ef589d8	703	chop($_ = &q(<<'EOT'));
	704	: close(ARGV);
	705	: @ARGV = ();
	706	: next LINE;
0a12ae7d	707	EOT
9ef589d8	708	$sawnext++;
8d063cd8	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
a687059c	721	sub fetchpat {
	722	local($outer) = @_;
	723	local($addr) = $outer;
	724	local($inbracket);
	725	local($prefix,$delim,$ch);
	726
0a12ae7d	727	# Process pattern one potential delimiter at a time.
	728
	729	DELIM: while (s#^([^\]+(\|)[\\/]*)([]+(\|)[\\/])##) {
a687059c	730	$prefix = $1;
a687059c	731	$delim = $2;
a687059c	732	if ($delim eq '\\') {
	733	s/(.)//;
	734	$ch = $1;
00bf170e	735	$delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
9f68db38	736	$ch = 'b' if $ch =~ /^[<>]$/;
9f68db38	737	$delim .= $ch;
a687059c	738	}
	739	elsif ($delim eq '[') {
	740	$inbracket = 1;
	741	s/^\^// && ($delim .= '^');
	742	s/^]// && ($delim .= ']');
a687059c	743	}
	744	elsif ($delim eq ']') {
	745	$inbracket = 0;
	746	}
	747	elsif ($inbracket \|\| $delim ne $outer) {
a687059c	748	$delim = '\\' . $delim;
	749	}
	750	$addr .= $prefix;
	751	$addr .= $delim;
	752	if ($delim eq $outer && !$inbracket) {
0a12ae7d	753	last DELIM;
a687059c	754	}
a687059c	755	}
9ef589d8	756	$addr =~ s/\t/\\t/g;
9ef589d8	757	&simplify($addr);
a687059c	758	$addr;
	759	}
	760
9ef589d8	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
a687059c	789	!NO!SUBS!
	790	chmod 755 s2p
	791	$eunicefix s2p