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 ../../config.sh . || \
11 ln ../../../config.sh . || \
12 (echo "Can't find config.sh."; exit 1)
17 echo "Extracting s2p (with variable substitutions)"
18 : This section of the file will have variable substitutions done on it.
19 : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
20 : Protect any dollar signs and backticks that you do not want interpreted
21 : by putting a backslash in front. You may delete these comments.
22 $spitshell >s2p <<!GROK!THIS!
28 : In the following dollars and backticks do not need the extra backslash.
29 $spitshell >>s2p <<'!NO!SUBS!'
31 # $Header: s2p.SH,v 3.0.1.6 90/10/20 02:21:43 lwall Locked $
34 # Revision 3.0.1.6 90/10/20 02:21:43 lwall
35 # patch37: changed some ". config.sh" to ". ./config.sh"
37 # Revision 3.0.1.5 90/10/16 11:32:40 lwall
38 # patch29: s2p modernized
40 # Revision 3.0.1.4 90/08/09 05:50:43 lwall
41 # patch19: s2p didn't translate \n right
43 # Revision 3.0.1.3 90/03/01 10:31:21 lwall
44 # patch9: s2p didn't handle \< and \>
46 # Revision 3.0.1.2 89/11/17 15:51:27 lwall
47 # patch5: in s2p, line labels without a subsequent statement were done wrong
48 # patch5: s2p left residue in /tmp
50 # Revision 3.0.1.1 89/11/11 05:08:25 lwall
51 # patch2: in s2p, + within patterns needed backslashing
52 # patch2: s2p was printing out some debugging info to the output file
54 # Revision 3.0 89/10/18 15:35:02 lwall
57 # Revision 2.0.1.1 88/07/11 23:26:23 root
58 # patch2: s2p didn't put a proper prologue on output script
60 # Revision 2.0 88/06/05 00:15:55 root
61 # Baseline version 2.0.
69 while ($ARGV[0] =~ /^-/) {
85 die "I don't recognize this switch: $_\n";
89 open(BODY,">/tmp/sperl$$") ||
90 &Die("Can't open temp file: $!\n");
93 if (!$assumen && !$assumep) {
95 while ($ARGV[0] =~ /^-/) {
102 die "I don't recognize this switch: $_\\n";
114 $printit++ unless $nflag;
122 # Wipe out surrounding whitespace.
126 # Perhaps it's a label/comment.
130 $label = &make_label($_);
135 if ($lastlinewaslabel++) {
137 print BODY &tab, ";\n";
146 $lastlinewaslabel = '';
149 # Look for one or two address clauses
160 $addr1 = &fetchpat('/');
168 $addr2 = &fetchpat('/');
170 &Die("Invalid second address at line $.\n");
172 $addr1 .= " .. $addr2";
175 # Now we check for metacommands {, }, and ! and worry
179 # a { to keep vi happy
186 $else = "$r else $l\n";
191 if (s/^{//) { # a } to keep vi happy
198 if ($addr2 || $addr1) {
199 $space = ' ' x $shiftwidth;
203 $_ = &transmogrify();
206 # See if we can optimize to modifier form.
209 if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
210 $_ !~ / if / && $_ !~ / unless /) {
212 $_ = substr($_,$shiftwidth,1000);
214 $_ = "$if ($addr1) $l\n$change$_$rmaybe";
220 @lines = split(/\n/,$_);
222 unless (s/^ *<<--//) {
235 if ($lastlinewaslabel++) {
237 print BODY &tab, ";\n";
242 if ($appendseen || $tseen || !$assumen) {
243 $printit++ if $dseen || (!$assumen && !$assumep);
255 { $printit++ unless $nflag; }
267 if ($atext) { print $atext; $atext = ''; }
276 open(HEAD,">/tmp/sperl2$$.c")
277 || &Die("Can't open temp file 2: $!\n");
278 print HEAD "#define PRINTIT\n" if ($printit);
279 print HEAD "#define APPENDSEEN\n" if ($appendseen);
280 print HEAD "#define TSEEN\n" if ($tseen);
281 print HEAD "#define DSEEN\n" if ($dseen);
282 print HEAD "#define ASSUMEN\n" if ($assumen);
283 print HEAD "#define ASSUMEP\n" if ($assumep);
284 if ($opens) {print HEAD "$opens\n";}
285 open(BODY,"/tmp/sperl$$")
286 || &Die("Can't reopen temp file: $!\n");
294 eval 'exec $bin/perl -S \$0 \$*'
295 if \$running_under_some_shell;
298 open(BODY,"cc -E /tmp/sperl2$$.c |") ||
299 &Die("Can't reopen temp file: $!\n");
313 unlink "sperl$$", "sperl2$$", "sperl2$$.c";
320 "\t" x ($indent / 8) . ' ' x ($indent % 8);
322 sub make_filehandle {
327 substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
330 open($_,'>$fname') || die "Can't create $fname";
338 $label =~ s/[^a-zA-Z0-9]/_/g;
339 if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
340 $label = substr($label,0,8);
342 # Could be a reserved word, so capitalize it.
343 substr($label,0,1) =~ y/a-z/A-Z/
344 if $label =~ /^[a-z]/;
372 { $printit++ unless $nflag; }
380 <<--#ifdef APPENDSEEN
381 if ($atext) {print $atext; $atext = '';}
393 $command = $space . '$atext .=' . "\n<<--'";
398 unless (s|\\$||) { $lastline = 1;}
400 s/^([ \t]*\n)/<><>$1/;
405 $_ = $command . "';";
410 if (/^c/) { $change = 1; }
411 $addr1 = '$iter = (' . $addr1 . ')';
412 $command = $space . 'if ($iter == 1) { print'
418 unless (s/\\$//) { $lastline = 1;}
420 s/^([ \t]*\n)/<><>$1/;
425 $_ = $command . "';}";
431 $space\$printit = '';
440 $delim = substr($_,1,1);
444 for ($i = 2; $i < $len; $i++) {
445 $c = substr($_,$i,1);
448 substr($_, $i, 0) = '\\';
467 $_ = substr($_,0,--$len);
469 elsif (substr($_,$i,1) =~ /^[n]$/) {
473 substr($_,$i,1) =~ /^[(){}\w]$/) {
476 substr($_, $i, 1) = '';
479 substr($_,$i,1) =~ /^[<>]$/) {
480 substr($_,$i,1) = 'b';
483 elsif ($c eq '[' && !$repl) {
484 $i++ if substr($_,$i,1) eq '^';
485 $i++ if substr($_,$i,1) eq ']';
491 elsif (!$repl && index("()+",$c) >= 0) {
492 substr($_, $i, 0) = '\\';
497 &Die("Malformed substitution at line $.\n")
499 $pat = substr($_, 0, $repl + 1);
500 $repl = substr($_, $repl+1, $end-$repl-1);
501 $end = substr($_, $end + 1, 1000);
505 $repl =~ s/[\\]([0-9])/$dol$1/g;
506 $subst = "$pat$repl$delim";
509 if ($end =~ s/^g//) {
513 if ($end =~ s/^p//) {
514 $cmd .= ' && (print)';
517 if ($end =~ s/^w[ \t]*//) {
518 $fh = &make_filehandle($end);
519 $cmd .= " && (print $fh \$_)";
523 &Die("Unrecognized substitution command".
524 "($end) at line $.\n");
528 $subst && \$tflag++$cmd;
543 $fh = &make_filehandle($_);
544 $_ = "print $fh \$_;";
552 $_ = "\$atext .= `cat $file 2>/dev/null`;";
557 $_ = 'print $1 if /(^.*\n)/;';
586 $_ = '$hold .= $_ ? $_ : "\n";';
596 $_ = '$_ .= $hold ? $hold : "\n";';
601 $_ = '($_, $hold) = ($hold, $_);';
612 $lab = &make_label($_);
613 if ($lab eq $toplabel) {
622 $_ = 'next LINE if $tflag;';
629 $lab = &make_label($_);
630 $_ = q/if ($tflag) {$tflag = ''; /;
631 if ($lab eq $toplabel) {
641 $_ = 'print "$.\n";';
656 s/(\n)(.)/$1$space$2/g;
665 local($addr) = $outer;
667 local($prefix,$delim,$ch);
669 # Process pattern one potential delimiter at a time.
671 DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
674 if ($delim eq '\\') {
677 $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
678 $ch = 'b' if $ch =~ /^[<>]$/;
681 elsif ($delim eq '[') {
683 s/^\^// && ($delim .= '^');
684 s/^]// && ($delim .= ']');
686 elsif ($delim eq ']') {
689 elsif ($inbracket || $delim ne $outer) {
690 $delim = '\\' . $delim;
694 if ($delim eq $outer && !$inbracket) {