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

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{'startperl'}
    eval 'exec perl -S \$0 "\$@"'
	if 0;
\$startperl = "$Config{startperl}";
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

# $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
#
# $Log:	s2p.SH,v $

$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");
:	$startperl
:	eval 'exec 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!

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