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