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.
4 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
8 if test ! -f config.sh; then
10 ln -s ../config.sh . || \
11 ln ../../config.sh . || \
12 ln ../../../config.sh . || \
13 (echo "Can't find config.sh."; exit 1)
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!
29 : In the following dollars and backticks do not need the extra backslash.
30 $spitshell >>s2p <<'!NO!SUBS!'
32 # $Header: s2p.SH,v 4.0 91/03/20 01:57:59 lwall Locked $
35 # Revision 4.0 91/03/20 01:57:59 lwall
44 while ($ARGV[0] =~ /^-/) {
60 die "I don't recognize this switch: $_\n";
64 open(BODY,">/tmp/sperl$$") ||
65 &Die("Can't open temp file: $!\n");
68 if (!$assumen && !$assumep) {
70 while ($ARGV[0] =~ /^-/) {
77 die "I don't recognize this switch: $_\\n";
89 $printit++ unless $nflag;
97 # Wipe out surrounding whitespace.
101 # Perhaps it's a label/comment.
105 $label = &make_label($_);
110 if ($lastlinewaslabel++) {
112 print BODY &tab, ";\n";
121 $lastlinewaslabel = '';
124 # Look for one or two address clauses
135 $addr1 = &fetchpat('/');
143 $addr2 = &fetchpat('/');
145 &Die("Invalid second address at line $.\n");
147 $addr1 .= " .. $addr2";
150 # Now we check for metacommands {, }, and ! and worry
154 # a { to keep vi happy
161 $else = "$r else $l\n";
166 if (s/^{//) { # a } to keep vi happy
173 if ($addr2 || $addr1) {
174 $space = ' ' x $shiftwidth;
178 $_ = &transmogrify();
181 # See if we can optimize to modifier form.
184 if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
185 $_ !~ / if / && $_ !~ / unless /) {
187 $_ = substr($_,$shiftwidth,1000);
189 $_ = "$if ($addr1) $l\n$change$_$rmaybe";
195 @lines = split(/\n/,$_);
197 unless (s/^ *<<--//) {
210 if ($lastlinewaslabel++) {
212 print BODY &tab, ";\n";
217 if ($appendseen || $tseen || !$assumen) {
218 $printit++ if $dseen || (!$assumen && !$assumep);
230 { $printit++ unless $nflag; }
242 if ($atext) { print $atext; $atext = ''; }
251 open(HEAD,">/tmp/sperl2$$.c")
252 || &Die("Can't open temp file 2: $!\n");
253 print HEAD "#define PRINTIT\n" if ($printit);
254 print HEAD "#define APPENDSEEN\n" if ($appendseen);
255 print HEAD "#define TSEEN\n" if ($tseen);
256 print HEAD "#define DSEEN\n" if ($dseen);
257 print HEAD "#define ASSUMEN\n" if ($assumen);
258 print HEAD "#define ASSUMEP\n" if ($assumep);
259 if ($opens) {print HEAD "$opens\n";}
260 open(BODY,"/tmp/sperl$$")
261 || &Die("Can't reopen temp file: $!\n");
269 eval 'exec $bin/perl -S \$0 \$*'
270 if \$running_under_some_shell;
273 open(BODY,"cc -E /tmp/sperl2$$.c |") ||
274 &Die("Can't reopen temp file: $!\n");
288 unlink "sperl$$", "sperl2$$", "sperl2$$.c";
295 "\t" x ($indent / 8) . ' ' x ($indent % 8);
297 sub make_filehandle {
302 substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
305 open($_,'>$fname') || die "Can't create $fname";
313 $label =~ s/[^a-zA-Z0-9]/_/g;
314 if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
315 $label = substr($label,0,8);
317 # Could be a reserved word, so capitalize it.
318 substr($label,0,1) =~ y/a-z/A-Z/
319 if $label =~ /^[a-z]/;
347 { $printit++ unless $nflag; }
355 <<--#ifdef APPENDSEEN
356 if ($atext) {print $atext; $atext = '';}
368 $command = $space . '$atext .=' . "\n<<--'";
373 unless (s|\\$||) { $lastline = 1;}
375 s/^([ \t]*\n)/<><>$1/;
380 $_ = $command . "';";
385 if (/^c/) { $change = 1; }
386 $addr1 = '$iter = (' . $addr1 . ')';
387 $command = $space . 'if ($iter == 1) { print'
393 unless (s/\\$//) { $lastline = 1;}
395 s/^([ \t]*\n)/<><>$1/;
400 $_ = $command . "';}";
406 $space\$printit = '';
415 $delim = substr($_,1,1);
419 for ($i = 2; $i < $len; $i++) {
420 $c = substr($_,$i,1);
423 substr($_, $i, 0) = '\\';
442 $_ = substr($_,0,--$len);
444 elsif (substr($_,$i,1) =~ /^[n]$/) {
448 substr($_,$i,1) =~ /^[(){}\w]$/) {
451 substr($_, $i, 1) = '';
454 substr($_,$i,1) =~ /^[<>]$/) {
455 substr($_,$i,1) = 'b';
458 elsif ($c eq '[' && !$repl) {
459 $i++ if substr($_,$i,1) eq '^';
460 $i++ if substr($_,$i,1) eq ']';
466 elsif (!$repl && index("()+",$c) >= 0) {
467 substr($_, $i, 0) = '\\';
472 &Die("Malformed substitution at line $.\n")
474 $pat = substr($_, 0, $repl + 1);
475 $repl = substr($_, $repl+1, $end-$repl-1);
476 $end = substr($_, $end + 1, 1000);
480 $repl =~ s/[\\]([0-9])/$dol$1/g;
481 $subst = "$pat$repl$delim";
484 if ($end =~ s/^g//) {
488 if ($end =~ s/^p//) {
489 $cmd .= ' && (print)';
492 if ($end =~ s/^w[ \t]*//) {
493 $fh = &make_filehandle($end);
494 $cmd .= " && (print $fh \$_)";
498 &Die("Unrecognized substitution command".
499 "($end) at line $.\n");
503 $subst && \$tflag++$cmd;
518 $fh = &make_filehandle($_);
519 $_ = "print $fh \$_;";
527 $_ = "\$atext .= `cat $file 2>/dev/null`;";
532 $_ = 'print $1 if /(^.*\n)/;';
561 $_ = '$hold .= $_ ? $_ : "\n";';
571 $_ = '$_ .= $hold ? $hold : "\n";';
576 $_ = '($_, $hold) = ($hold, $_);';
587 $lab = &make_label($_);
588 if ($lab eq $toplabel) {
597 $_ = 'next LINE if $tflag;';
604 $lab = &make_label($_);
605 $_ = q/if ($tflag) {$tflag = ''; /;
606 if ($lab eq $toplabel) {
616 $_ = 'print "$.\n";';
631 s/(\n)(.)/$1$space$2/g;
640 local($addr) = $outer;
642 local($prefix,$delim,$ch);
644 # Process pattern one potential delimiter at a time.
646 DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
649 if ($delim eq '\\') {
652 $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
653 $ch = 'b' if $ch =~ /^[<>]$/;
656 elsif ($delim eq '[') {
658 s/^\^// && ($delim .= '^');
659 s/^]// && ($delim .= ']');
661 elsif ($delim eq ']') {
664 elsif ($inbracket || $delim ne $outer) {
665 $delim = '\\' . $delim;
669 if ($delim eq $outer && !$inbracket) {