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