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