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