x2p/s2p

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