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.4 90/08/09 05:50:43 lwall Locked $
34 # Revision 3.0.1.4 90/08/09 05:50:43 lwall
35 # patch19: s2p didn't translate \n right
37 # Revision 3.0.1.3 90/03/01 10:31:21 lwall
38 # patch9: s2p didn't handle \< and \>
40 # Revision 3.0.1.2 89/11/17 15:51:27 lwall
41 # patch5: in s2p, line labels without a subsequent statement were done wrong
42 # patch5: s2p left residue in /tmp
44 # Revision 3.0.1.1 89/11/11 05:08:25 lwall
45 # patch2: in s2p, + within patterns needed backslashing
46 # patch2: s2p was printing out some debugging info to the output file
48 # Revision 3.0 89/10/18 15:35:02 lwall
51 # Revision 2.0.1.1 88/07/11 23:26:23 root
52 # patch2: s2p didn't put a proper prologue on output script
54 # Revision 2.0 88/06/05 00:15:55 root
55 # Baseline version 2.0.
64 while ($ARGV[0] =~ '^-') {
80 die "I don't recognize this switch: $_\n";
84 open(body,">/tmp/sperl$$") || do Die("Can't open temp file");
87 if (!$assumen && !$assumep) {
89 'while ($ARGV[0] =~ /^-/) {
96 die "I don\'t recognize this switch: $_\\n";
107 $printit++ unless $nflag;
117 $label = do make_label($_);
122 if ($lastlinewaslabel++) {
124 print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
133 $lastlinewaslabel = '';
144 $addr1 = do fetchpat('/');
152 $addr2 = do fetchpat('/');
154 do Die("Invalid second address at line $.\n");
156 $addr1 .= " .. $addr2";
158 # a { to keep vi happy
166 $else = "$r else $l\n";
171 if (s/^{//) { # a } to keep vi happy
178 if ($addr2 || $addr1) {
179 $space = ' ' x $shiftwidth;
183 $_ = do transmogrify();
187 if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
188 $_ !~ / if / && $_ !~ / unless /) {
190 $_ = substr($_,$shiftwidth,1000);
193 $_ = "$if ($addr1) $l\n$change$command$rmaybe";
199 @lines = split(/\n/,$_);
200 while ($#lines >= 0) {
202 unless (s/^ *<<--//) {
203 print body "\t" x ($indent / 8), ' ' x ($indent % 8);
215 if ($lastlinewaslabel++) {
217 print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
222 if ($appendseen || $tseen || !$assumen) {
223 $printit++ if $dseen || (!$assumen && !$assumep);
231 if ($printit) { print;} else { $printit++ unless $nflag; }
243 if ($atext) { print $atext; $atext = \'\'; }
252 open(head,">/tmp/sperl2$$.c") || do Die("Can't open temp file 2");
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$$") || do Die("Can't reopen temp file");
267 eval \"exec $bin/perl -S \$0 \$*\"
268 if \$running_under_some_shell;
271 open(body,"cc -E /tmp/sperl2$$.c |") ||
272 do Die("Can't reopen temp file");
281 unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
284 unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
287 sub make_filehandle {
291 if (/^([a-z])([a-z]*)$/) {
294 $first =~ y/a-z/A-Z/;
298 $opens .= "open($_,'>$fname') || die \"Can't create $fname\";\n";
305 $label =~ s/[^a-zA-Z0-9]/_/g;
306 if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
307 $label = substr($label,0,8);
308 if ($label =~ /^([a-z])([a-z]*)$/) { # could be reserved word
311 $first =~ y/a-z/A-Z/; # so capitalize it
312 $label = $first . $rest;
336 if ($printit) { print;} else { $printit++ unless $nflag; }
344 <<--#ifdef APPENDSEEN
345 if ($atext) {print $atext; $atext = \'\';}
356 $command = $space . '$atext .=' . "\n<<--'";
361 unless (s|\\$||) { $lastline = 1;}
363 s/^([ \t]*\n)/<><>$1/;
368 $_ = $command . "';";
373 if (/^c/) { $change = 1; }
374 $addr1 = '$iter = (' . $addr1 . ')';
375 $command = $space . 'if ($iter == 1) { print' . "\n<<--'";
380 unless (s/\\$//) { $lastline = 1;}
382 s/^([ \t]*\n)/<><>$1/;
387 $_ = $command . "';}";
393 $space\$printit = '';
401 $delim = substr($_,1,1);
405 for ($i = 2; $i < $len; $i++) {
406 $c = substr($_,$i,1);
409 $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
428 $_ = substr($_,0,--$len);
430 elsif (substr($_,$i,1) =~ /^[n]$/) {
433 elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) {
436 $_ = substr($_,0,$i) . substr($_,$i+1,10000);
438 elsif (!$repl && substr($_,$i,1) =~ /^[<>]$/) {
439 substr($_,$i,1) = 'b';
442 elsif ($c eq '[' && !$repl) {
443 $i++ if substr($_,$i,1) eq '^';
444 $i++ if substr($_,$i,1) eq ']';
450 elsif (!$repl && index("()+",$c) >= 0) {
451 $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
456 do Die("Malformed substitution at line $.\n") unless $end;
457 $pat = substr($_, 0, $repl + 1);
458 $repl = substr($_, $repl + 1, $end - $repl - 1);
459 $end = substr($_, $end + 1, 1000);
463 $repl =~ s/[\\]([0-9])/$dol$1/g;
464 $subst = "$pat$repl$delim";
467 if ($end =~ s/^g//) { $subst .= 'g'; next; }
468 if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; }
469 if ($end =~ s/^w[ \t]*//) {
470 $fh = do make_filehandle($end);
471 $cmd .= " && (print $fh \$_)";
475 do Die("Unrecognized substitution command ($end) at line $.\n");
479 $subst && \$tflag++$cmd;
493 $fh = do make_filehandle($_);
494 $_ = "print $fh \$_;";
502 $_ = "\$atext .= `cat $file 2>/dev/null`;";
507 $_ = 'print $1 if /(^.*\n)/;';
534 $_ = '$hold .= $_ ? $_ : "\n";';
544 $_ = '$_ .= $hold ? $hold : "\n";';
549 $_ = '($_, $hold) = ($hold, $_);';
560 $lab = do make_label($_);
561 if ($lab eq $toplabel) {
570 $_ = 'next line if $tflag;';
577 $lab = do make_label($_);
578 if ($lab eq $toplabel) {
579 $_ = 'if ($tflag) {$tflag = \'\'; redo line;}';
581 $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}";
588 $_ = 'print "$.\n";';
602 s/(\n)(.)/$1$space$2/g;
611 local($addr) = $outer;
613 local($prefix,$delim,$ch);
615 delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) {
618 if ($delim eq '\\') {
621 $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
622 $ch = 'b' if $ch =~ /^[<>]$/;
625 elsif ($delim eq '[') {
627 s/^\^// && ($delim .= '^');
628 s/^]// && ($delim .= ']');
630 elsif ($delim eq ']') {
633 elsif ($inbracket || $delim ne $outer) {
634 $delim = '\\' . $delim;
638 if ($delim eq $outer && !$inbracket) {