x2p/s2p.SH

   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 . || \
  10         ln ../../config.sh . || \
  11         ln ../../../config.sh . || \
  12         (echo "Can't find config.sh."; exit 1)
  13     fi
  14     . config.sh
  15     ;;
  16 esac
  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!
  23 #!$bin/perl
  24
  25 \$bin = '$bin';
  26 !GROK!THIS!
  27
  28 : In the following dollars and backticks do not need the extra backslash.
  29 $spitshell >>s2p <<'!NO!SUBS!'
  30
  31 # $Header: s2p.SH,v 3.0.1.2 89/11/17 15:51:27 lwall Locked $
  32 #
  33 # $Log: s2p.SH,v $
  34 # Revision 3.0.1.2  89/11/17  15:51:27  lwall
  35 # patch5: in s2p, line labels without a subsequent statement were done wrong
  36 # patch5: s2p left residue in /tmp
  37 #
  38 # Revision 3.0.1.1  89/11/11  05:08:25  lwall
  39 # patch2: in s2p, + within patterns needed backslashing
  40 # patch2: s2p was printing out some debugging info to the output file
  41 #
  42 # Revision 3.0  89/10/18  15:35:02  lwall
  43 # 3.0 baseline
  44 #
  45 # Revision 2.0.1.1  88/07/11  23:26:23  root
  46 # patch2: s2p didn't put a proper prologue on output script
  47 #
  48 # Revision 2.0  88/06/05  00:15:55  root
  49 # Baseline version 2.0.
  50 #
  51 #
  52
  53 $indent = 4;
  54 $shiftwidth = 4;
  55 $l = '{'; $r = '}';
  56 $tempvar = '1';
  57
  58 while ($ARGV[0] =~ '^-') {
  59     $_ = shift;
  60   last if /^--/;
  61     if (/^-D/) {
  62         $debug++;
  63         open(body,'>-');
  64         next;
  65     }
  66     if (/^-n/) {
  67         $assumen++;
  68         next;
  69     }
  70     if (/^-p/) {
  71         $assumep++;
  72         next;
  73     }
  74     die "I don't recognize this switch: $_\n";
  75 }
  76
  77 unless ($debug) {
  78     open(body,">/tmp/sperl$$") || do Die("Can't open temp file");
  79 }
  80
  81 if (!$assumen && !$assumep) {
  82     print body
  83 'while ($ARGV[0] =~ /^-/) {
  84     $_ = shift;
  85   last if /^--/;
  86     if (/^-n/) {
  87         $nflag++;
  88         next;
  89     }
  90     die "I don\'t recognize this switch: $_\\n";
  91 }
  92
  93 ';
  94 }
  95
  96 print body '
  97 #ifdef PRINTIT
  98 #ifdef ASSUMEP
  99 $printit++;
 100 #else
 101 $printit++ unless $nflag;
 102 #endif
 103 #endif
 104 line: while (<>) {
 105 ';
 106
 107 line: while (<>) {
 108     s/[ \t]*(.*)\n$/$1/;
 109     if (/^:/) {
 110         s/^:[ \t]*//;
 111         $label = do make_label($_);
 112         if ($. == 1) {
 113             $toplabel = $label;
 114         }
 115         $_ = "$label:";
 116         if ($lastlinewaslabel++) {
 117             $indent += 4;
 118             print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
 119             $indent -= 4;
 120         }
 121         if ($indent >= 2) {
 122             $indent -= 2;
 123             $indmod = 2;
 124         }
 125         next;
 126     } else {
 127         $lastlinewaslabel = '';
 128     }
 129     $addr1 = '';
 130     $addr2 = '';
 131     if (s/^([0-9]+)//) {
 132         $addr1 = "$1";
 133     }
 134     elsif (s/^\$//) {
 135         $addr1 = 'eof()';
 136     }
 137     elsif (s|^/||) {
 138         $addr1 = do fetchpat('/');
 139     }
 140     if (s/^,//) {
 141         if (s/^([0-9]+)//) {
 142             $addr2 = "$1";
 143         } elsif (s/^\$//) {
 144             $addr2 = "eof()";
 145         } elsif (s|^/||) {
 146             $addr2 = do fetchpat('/');
 147         } else {
 148             do Die("Invalid second address at line $.\n");
 149         }
 150         $addr1 .= " .. $addr2";
 151     }
 152                                         # a { to keep vi happy
 153     s/^[ \t]+//;
 154     if ($_ eq '}') {
 155         $indent -= 4;
 156         next;
 157     }
 158     if (s/^!//) {
 159         $if = 'unless';
 160         $else = "$r else $l\n";
 161     } else {
 162         $if = 'if';
 163         $else = '';
 164     }
 165     if (s/^{//) {       # a } to keep vi happy
 166         $indmod = 4;
 167         $redo = $_;
 168         $_ = '';
 169         $rmaybe = '';
 170     } else {
 171         $rmaybe = "\n$r";
 172         if ($addr2 || $addr1) {
 173             $space = ' ' x $shiftwidth;
 174         } else {
 175             $space = '';
 176         }
 177         $_ = do transmogrify();
 178     }
 179
 180     if ($addr1) {
 181         if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
 182           $_ !~ / if / && $_ !~ / unless /) {
 183             s/;$/ $if $addr1;/;
 184             $_ = substr($_,$shiftwidth,1000);
 185         } else {
 186             $command = $_;
 187             $_ = "$if ($addr1) $l\n$change$command$rmaybe";
 188         }
 189         $change = '';
 190         next line;
 191     }
 192 } continue {
 193     @lines = split(/\n/,$_);
 194     while ($#lines >= 0) {
 195         $_ = shift(lines);
 196         unless (s/^ *<<--//) {
 197             print body "\t" x ($indent / 8), ' ' x ($indent % 8);
 198         }
 199         print body $_, "\n";
 200     }
 201     $indent += $indmod;
 202     $indmod = 0;
 203     if ($redo) {
 204         $_ = $redo;
 205         $redo = '';
 206         redo line;
 207     }
 208 }
 209 if ($lastlinewaslabel++) {
 210     $indent += 4;
 211     print body "\t" x ($indent / 8), ' ' x ($indent % 8), ";\n";
 212     $indent -= 4;
 213 }
 214
 215 print body "}\n";
 216 if ($appendseen || $tseen || !$assumen) {
 217     $printit++ if $dseen || (!$assumen && !$assumep);
 218     print body '
 219 continue {
 220 #ifdef PRINTIT
 221 #ifdef DSEEN
 222 #ifdef ASSUMEP
 223     print if $printit++;
 224 #else
 225     if ($printit) { print;} else { $printit++ unless $nflag; }
 226 #endif
 227 #else
 228     print if $printit;
 229 #endif
 230 #else
 231     print;
 232 #endif
 233 #ifdef TSEEN
 234     $tflag = \'\';
 235 #endif
 236 #ifdef APPENDSEEN
 237     if ($atext) { print $atext; $atext = \'\'; }
 238 #endif
 239 }
 240 ';
 241 }
 242
 243 close body;
 244
 245 unless ($debug) {
 246     open(head,">/tmp/sperl2$$.c") || do Die("Can't open temp file 2");
 247     print head "#define PRINTIT\n" if ($printit);
 248     print head "#define APPENDSEEN\n" if ($appendseen);
 249     print head "#define TSEEN\n" if ($tseen);
 250     print head "#define DSEEN\n" if ($dseen);
 251     print head "#define ASSUMEN\n" if ($assumen);
 252     print head "#define ASSUMEP\n" if ($assumep);
 253     if ($opens) {print head "$opens\n";}
 254     open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file");
 255     while (<body>) {
 256         print head $_;
 257     }
 258     close head;
 259
 260     print "#!$bin/perl
 261 eval \"exec $bin/perl -S \$0 \$*\"
 262         if \$running_under_some_shell;
 263
 264 ";
 265     open(body,"cc -E /tmp/sperl2$$.c |") ||
 266         do Die("Can't reopen temp file");
 267     while (<body>) {
 268         /^# [0-9]/ && next;
 269         /^[ \t]*$/ && next;
 270         s/^<><>//;
 271         print;
 272     }
 273 }
 274
 275 unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
 276
 277 sub Die {
 278     unlink "/tmp/sperl$$", "/tmp/sperl2$$", "/tmp/sperl2$$.c";
 279     die $_[0];
 280 }
 281 sub make_filehandle {
 282     $fname = $_ = $_[0];
 283     s/[^a-zA-Z]/_/g;
 284     s/^_*//;
 285     if (/^([a-z])([a-z]*)$/) {
 286         $first = $1;
 287         $rest = $2;
 288         $first =~ y/a-z/A-Z/;
 289         $_ = $first . $rest;
 290     }
 291     if (!$seen{$_}) {
 292         $opens .= "open($_,'>$fname') || die \"Can't create $fname\";\n";
 293     }
 294     $seen{$_} = $_;
 295 }
 296
 297 sub make_label {
 298     $label = $_[0];
 299     $label =~ s/[^a-zA-Z0-9]/_/g;
 300     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
 301     $label = substr($label,0,8);
 302     if ($label =~ /^([a-z])([a-z]*)$/) {        # could be reserved word
 303         $first = $1;
 304         $rest = $2;
 305         $first =~ y/a-z/A-Z/;                   # so capitalize it
 306         $label = $first . $rest;
 307     }
 308     $label;
 309 }
 310
 311 sub transmogrify {
 312     {   # case
 313         if (/^d/) {
 314             $dseen++;
 315             $_ = '
 316 <<--#ifdef PRINTIT
 317 $printit = \'\';
 318 <<--#endif
 319 next line;';
 320             next;
 321         }
 322
 323         if (/^n/) {
 324             $_ =
 325 '<<--#ifdef PRINTIT
 326 <<--#ifdef DSEEN
 327 <<--#ifdef ASSUMEP
 328 print if $printit++;
 329 <<--#else
 330 if ($printit) { print;} else { $printit++ unless $nflag; }
 331 <<--#endif
 332 <<--#else
 333 print if $printit;
 334 <<--#endif
 335 <<--#else
 336 print;
 337 <<--#endif
 338 <<--#ifdef APPENDSEEN
 339 if ($atext) {print $atext; $atext = \'\';}
 340 <<--#endif
 341 $_ = <>;
 342 <<--#ifdef TSEEN
 343 $tflag = \'\';
 344 <<--#endif';
 345             next;
 346         }
 347
 348         if (/^a/) {
 349             $appendseen++;
 350             $command = $space .  '$atext .=' . "\n<<--'";
 351             $lastline = 0;
 352             while (<>) {
 353                 s/^[ \t]*//;
 354                 s/^[\\]//;
 355                 unless (s|\\$||) { $lastline = 1;}
 356                 s/'/\\'/g;
 357                 s/^([ \t]*\n)/<><>$1/;
 358                 $command .= $_;
 359                 $command .= '<<--';
 360                 last if $lastline;
 361             }
 362             $_ = $command . "';";
 363             last;
 364         }
 365
 366         if (/^[ic]/) {
 367             if (/^c/) { $change = 1; }
 368             $addr1 = '$iter = (' . $addr1 . ')';
 369             $command = $space .  'if ($iter == 1) { print' . "\n<<--'";
 370             $lastline = 0;
 371             while (<>) {
 372                 s/^[ \t]*//;
 373                 s/^[\\]//;
 374                 unless (s/\\$//) { $lastline = 1;}
 375                 s/'/\\'/g;
 376                 s/^([ \t]*\n)/<><>$1/;
 377                 $command .= $_;
 378                 $command .= '<<--';
 379                 last if $lastline;
 380             }
 381             $_ = $command . "';}";
 382             if ($change) {
 383                 $dseen++;
 384                 $change = "$_\n";
 385                 $_ = "
 386 <<--#ifdef PRINTIT
 387 $space\$printit = '';
 388 <<--#endif
 389 ${space}next line;";
 390             }
 391             last;
 392         }
 393
 394         if (/^s/) {
 395             $delim = substr($_,1,1);
 396             $len = length($_);
 397             $repl = $end = 0;
 398             $inbracket = 0;
 399             for ($i = 2; $i < $len; $i++) {
 400                 $c = substr($_,$i,1);
 401                 if ($c eq $delim) {
 402                     if ($inbracket) {
 403                         $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
 404                         $i++;
 405                         $len++;
 406                     }
 407                     else {
 408                         if ($repl) {
 409                             $end = $i;
 410                             last;
 411                         } else {
 412                             $repl = $i;
 413                         }
 414                     }
 415                 }
 416                 elsif ($c eq '\\') {
 417                     $i++;
 418                     if ($i >= $len) {
 419                         $_ .= 'n';
 420                         $_ .= <>;
 421                         $len = length($_);
 422                         $_ = substr($_,0,--$len);
 423                     }
 424                     elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) {
 425                         $i--;
 426                         $len--;
 427                         $_ = substr($_,0,$i) . substr($_,$i+1,10000);
 428                     }
 429                 }
 430                 elsif ($c eq '[' && !$repl) {
 431                     $i++ if substr($_,$i,1) eq '^';
 432                     $i++ if substr($_,$i,1) eq ']';
 433                     $inbracket = 1;
 434                 }
 435                 elsif ($c eq ']') {
 436                     $inbracket = 0;
 437                 }
 438                 elsif (!$repl && index("()+",$c) >= 0) {
 439                     $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
 440                     $i++;
 441                     $len++;
 442                 }
 443             }
 444             do Die("Malformed substitution at line $.\n") unless $end;
 445             $pat = substr($_, 0, $repl + 1);
 446             $repl = substr($_, $repl + 1, $end - $repl - 1);
 447             $end = substr($_, $end + 1, 1000);
 448             $dol = '$';
 449             $repl =~ s/\$/\\$/;
 450             $repl =~ s'&'$&'g;
 451             $repl =~ s/[\\]([0-9])/$dol$1/g;
 452             $subst = "$pat$repl$delim";
 453             $cmd = '';
 454             while ($end) {
 455                 if ($end =~ s/^g//) { $subst .= 'g'; next; }
 456                 if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; }
 457                 if ($end =~ s/^w[ \t]*//) {
 458                     $fh = do make_filehandle($end);
 459                     $cmd .= " && (print $fh \$_)";
 460                     $end = '';
 461                     next;
 462                 }
 463                 do Die("Unrecognized substitution command ($end) at line $.\n");
 464             }
 465             $_ =
 466 "<<--#ifdef TSEEN
 467 $subst && \$tflag++$cmd;
 468 <<--#else
 469 $subst$cmd;
 470 <<--#endif";
 471             next;
 472         }
 473
 474         if (/^p/) {
 475             $_ = 'print;';
 476             next;
 477         }
 478
 479         if (/^w/) {
 480             s/^w[ \t]*//;
 481             $fh = do make_filehandle($_);
 482             $_ = "print $fh \$_;";
 483             next;
 484         }
 485
 486         if (/^r/) {
 487             $appendseen++;
 488             s/^r[ \t]*//;
 489             $file = $_;
 490             $_ = "\$atext .= `cat $file 2>/dev/null`;";
 491             next;
 492         }
 493
 494         if (/^P/) {
 495             $_ = 'print $1 if /(^.*\n)/;';
 496             next;
 497         }
 498
 499         if (/^D/) {
 500             $_ =
 501 's/^.*\n//;
 502 redo line if $_;
 503 next line;';
 504             next;
 505         }
 506
 507         if (/^N/) {
 508             $_ = '
 509 $_ .= <>;
 510 <<--#ifdef TSEEN
 511 $tflag = \'\';
 512 <<--#endif';
 513             next;
 514         }
 515
 516         if (/^h/) {
 517             $_ = '$hold = $_;';
 518             next;
 519         }
 520
 521         if (/^H/) {
 522             $_ = '$hold .= $_ ? $_ : "\n";';
 523             next;
 524         }
 525
 526         if (/^g/) {
 527             $_ = '$_ = $hold;';
 528             next;
 529         }
 530
 531         if (/^G/) {
 532             $_ = '$_ .= $hold ? $hold : "\n";';
 533             next;
 534         }
 535
 536         if (/^x/) {
 537             $_ = '($_, $hold) = ($hold, $_);';
 538             next;
 539         }
 540
 541         if (/^b$/) {
 542             $_ = 'next line;';
 543             next;
 544         }
 545
 546         if (/^b/) {
 547             s/^b[ \t]*//;
 548             $lab = do make_label($_);
 549             if ($lab eq $toplabel) {
 550                 $_ = 'redo line;';
 551             } else {
 552                 $_ = "goto $lab;";
 553             }
 554             next;
 555         }
 556
 557         if (/^t$/) {
 558             $_ = 'next line if $tflag;';
 559             $tseen++;
 560             next;
 561         }
 562
 563         if (/^t/) {
 564             s/^t[ \t]*//;
 565             $lab = do make_label($_);
 566             if ($lab eq $toplabel) {
 567                 $_ = 'if ($tflag) {$tflag = \'\'; redo line;}';
 568             } else {
 569                 $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}";
 570             }
 571             $tseen++;
 572             next;
 573         }
 574
 575         if (/^=/) {
 576             $_ = 'print "$.\n";';
 577             next;
 578         }
 579
 580         if (/^q/) {
 581             $_ =
 582 'close(ARGV);
 583 @ARGV = ();
 584 next line;';
 585             next;
 586         }
 587     } continue {
 588         if ($space) {
 589             s/^/$space/;
 590             s/(\n)(.)/$1$space$2/g;
 591         }
 592         last;
 593     }
 594     $_;
 595 }
 596
 597 sub fetchpat {
 598     local($outer) = @_;
 599     local($addr) = $outer;
 600     local($inbracket);
 601     local($prefix,$delim,$ch);
 602
 603     delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) {
 604         $prefix = $1;
 605         $delim = $2;
 606         if ($delim eq '\\') {
 607             s/(.)//;
 608             $ch = $1;
 609             $delim = '' if $ch =~ /^[(){}\w]$/;
 610             $delim .= $1;
 611         }
 612         elsif ($delim eq '[') {
 613             $inbracket = 1;
 614             s/^\^// && ($delim .= '^');
 615             s/^]// && ($delim .= ']');
 616         }
 617         elsif ($delim eq ']') {
 618             $inbracket = 0;
 619         }
 620         elsif ($inbracket || $delim ne $outer) {
 621             $delim = '\\' . $delim;
 622         }
 623         $addr .= $prefix;
 624         $addr .= $delim;
 625         if ($delim eq $outer && !$inbracket) {
 626             last delim;
 627         }
 628     }
 629     $addr;
 630 }
 631
 632 !NO!SUBS!
 633 chmod 755 s2p
 634 $eunicefix s2p