ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
Revision: 1.30
Committed: Mon Mar 13 16:59:36 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.29: +27 -9 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 =head1 NAME
2
3 Faster - do some things faster
4
5 =head1 SYNOPSIS
6
7 use Faster;
8
9 perl -MFaster ...
10
11 =head1 DESCRIPTION
12
13 This module implements a very simple-minded JIT. It works by more or less
14 translating every function it sees into a C program, compiling it and then
15 replacing the function by the compiled code.
16
17 As a result, startup times are immense, as every function might lead to a
18 full-blown compilation.
19
20 The speed improvements are also not great, you can expect 20% or so on
21 average, for code that runs very often.
22
23 Faster is in the early stages of development. Due to its design its
24 relatively safe to use (it will either work or simply slowdown the program
25 immensely, but rarely cause bugs).
26
27 Usage is very easy, just C<use Faster> and every function called from then
28 on will be compiled.
29
30 Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in
31 your F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it
32 will even create those temporary files in an insecure manner, so watch
33 out.
34
35 =over 4
36
37 =cut
38
39 package Faster;
40
41 no warnings;
42
43 use strict;
44 use Config;
45 use B ();
46 use DynaLoader ();
47 use Digest::MD5 ();
48 use Storable ();
49 use Fcntl ();
50
51 BEGIN {
52 our $VERSION = '0.01';
53
54 require XSLoader;
55 XSLoader::load __PACKAGE__, $VERSION;
56 }
57
58 my $CACHEDIR =
59 $ENV{FASTER_CACHE}
60 || (exists $ENV{HOME} && "$ENV{HOME}/.perl-faster-cache")
61 || do {
62 require File::Temp;
63 File::Temp::tempdir (CLEANUP => 1)
64 };
65
66 my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
67 my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
68 my $LIBS = "$Config{libs}";
69 my $_o = $Config{_o};
70 my $_so = ".so";
71
72 # we don't need no steenking PIC on x86
73 $COMPILE =~ s/-f(?:PIC|pic)//g
74 if $Config{archname} =~ /^(i[3456]86)-/;
75
76 my $opt_assert = $ENV{FASTER_DEBUG} > 1;
77 my $verbose = $ENV{FASTER_VERBOSE}+0;
78
79 warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
80
81 our $source;
82
83 our @ops;
84 our $insn;
85 our $op;
86 our $op_name;
87 our @op_loop;
88 our %op_regcomp;
89
90 # ops that cause immediate return to the interpreter
91 my %f_unsafe = map +($_ => undef), qw(
92 leavesub leavesublv return
93 goto last redo next
94 eval flip leaveeval entertry
95 formline grepstart mapstart
96 substcont entereval require
97 );
98
99 # ops with known stack extend behaviour
100 # the values given are maximum values
101 my %extend = (
102 pushmark => 0,
103 nextstate => 0, # might reduce the stack
104 unstack => 0,
105 enter => 0,
106
107 stringify => 0,
108 not => 0,
109 and => 0,
110 or => 0,
111 gvsv => 0,
112 rv2gv => 0,
113 preinc => 0,
114 predec => 0,
115 postinc => 0,
116 postdec => 0,
117 aelem => 0,
118 helem => 0,
119 qr => 1, #???
120 pushre => 1,
121 gv => 1,
122 aelemfast => 1,
123 aelem => 0,
124 padsv => 1,
125 const => 1,
126 pop => 1,
127 shift => 1,
128 eq => -1,
129 ne => -1,
130 gt => -1,
131 lt => -1,
132 ge => -1,
133 lt => -1,
134 cond_expr => -1,
135 add => -1,
136 subtract => -1,
137 multiply => -1,
138 divide => -1,
139 aassign => 0,
140 sassign => -2,
141 method => 0,
142 method_named => 1,
143 );
144
145 # ops that do not need an ASYNC_CHECK
146 my %f_noasync = map +($_ => undef), qw(
147 mapstart grepstart match entereval
148 enteriter entersub leaveloop
149
150 pushmark nextstate caller
151
152 const stub unstack
153 last next redo goto seq
154 padsv padav padhv padany
155 aassign sassign orassign
156 rv2av rv2cv rv2gv rv2hv refgen
157 gv gvsv
158 add subtract multiply divide
159 complement cond_expr and or not bit_and bit_or bit_xor
160 defined
161 method method_named bless
162 preinc postinc predec postdec
163 aelem aelemfast helem delete exists
164 pushre subst list lslice join split concat
165 length substr stringify ord
166 push pop shift unshift
167 eq ne gt lt ge le
168 regcomp regcreset regcmaybe
169 );
170
171 my %callop = (
172 entersub => "(PL_op->op_ppaddr) (aTHX)",
173 mapstart => "Perl_pp_grepstart (aTHX)",
174 );
175
176 sub callop {
177 $callop{$op_name} || "Perl_pp_$op_name (aTHX)"
178 }
179
180 sub assert {
181 return unless $opt_assert;
182 $source .= " assert ((\"$op_name\", ($_[0])));\n";
183 }
184
185 sub out_callop {
186 assert "nextop == (OP *)$$op";
187 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
188 }
189
190 sub out_cond_jump {
191 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
192 }
193
194 sub out_jump_next {
195 out_cond_jump $op_regcomp{$$op}
196 if $op_regcomp{$$op};
197
198 assert "nextop == (OP *)${$op->next}";
199 $source .= " goto op_${$op->next};\n";
200 }
201
202 sub out_next {
203 $source .= " nextop = (OP *)${$op->next}L;\n";
204
205 out_jump_next;
206 }
207
208 sub out_linear {
209 out_callop;
210 out_jump_next;
211 }
212
213 sub op_entersub {
214 out_callop;
215 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n";
216 out_jump_next;
217 }
218
219 *op_require = \&op_entersub;
220
221 sub op_nextstate {
222 $source .= " PL_curcop = (COP *)nextop;\n";
223 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
224 $source .= " FREETMPS;\n";
225
226 out_next;
227 }
228
229 sub op_pushmark {
230 $source .= " faster_PUSHMARK (PL_stack_sp);\n";
231
232 out_next;
233 }
234
235 if ($Config{useithreads} ne "define") {
236 # disable optimisations on ithreads
237
238 *op_const = sub {
239 $source .= " { dSP; PUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
240
241 $ops[0]{follows_const}++ if @ops;#d#
242
243 out_next;
244 };
245
246 *op_gv = \&op_const;
247
248 *op_aelemfast = sub {
249 my $targ = $op->targ;
250 my $private = $op->private;
251
252 $source .= " {\n";
253
254 if ($op->flags & B::OPf_SPECIAL) {
255 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
256 } else {
257 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
258 }
259
260 if ($op->flags & B::OPf_MOD) {
261 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
262 } else {
263 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
264 }
265
266 if (!($op->flags & B::OPf_MOD)) {
267 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
268 }
269
270 $source .= " dSP;\n";
271 $source .= " PUSHs (sv);\n";
272 $source .= " PUTBACK;\n";
273 $source .= " }\n";
274
275 out_next;
276 };
277
278 *op_gvsv = sub {
279 $source .= " {\n";
280 $source .= " dSP;\n";
281
282 if ($op->private & B::OPpLVAL_INTRO) {
283 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
284 } else {
285 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
286 }
287
288 $source .= " PUTBACK;\n";
289 $source .= " }\n";
290
291 out_next;
292 };
293 }
294
295 # does kill Crossfire/res2pm
296 sub op_stringify {
297 my $targ = $op->targ;
298
299 $source .= <<EOF;
300 {
301 dSP;
302 SV *targ = PAD_SV ((PADOFFSET)$targ);
303 sv_copypv (TARG, TOPs);
304 SETTARG;
305 PUTBACK;
306 }
307 EOF
308
309 out_next;
310 }
311
312 sub op_and {
313 $source .= <<EOF;
314 {
315 dSP;
316
317 if (SvTRUE (TOPs))
318 {
319 --SP;
320 PUTBACK;
321 nextop = (OP *)${$op->other}L;
322 goto op_${$op->other};
323 }
324 }
325 EOF
326
327 out_next;
328 }
329
330 sub op_or {
331 $source .= <<EOF;
332 {
333 dSP;
334
335 if (!SvTRUE (TOPs))
336 {
337 --SP;
338 PUTBACK;
339 nextop = (OP *)${$op->other}L;
340 goto op_${$op->other};
341 }
342 }
343 EOF
344
345 out_next;
346 }
347
348 sub op_padsv {
349 my $flags = $op->flags;
350 my $padofs = "(PADOFFSET)" . $op->targ;
351
352 $source .= <<EOF;
353 {
354 dSP;
355 SV *sv = PAD_SVl ($padofs);
356 EOF
357
358 if (($flags & B::OPf_MOD) && ($op->private & B::OPpLVAL_INTRO)) {
359 $source .= " SAVECLEARSV (PAD_SVl ($padofs));\n";
360 $ops[0]{follows_padsv_lval_intro}++ if @ops;#d#
361 }
362
363 $source .= <<EOF;
364 PUSHs (sv);
365 PUTBACK;
366 EOF
367
368 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {
369 $source .= " if (!SvROK (sv)) vivify_ref (sv, " . $op->private . " & OPpDEREF);\n";
370 }
371 $source .= " }\n";
372
373 out_next;
374 }
375
376 sub op_sassign {
377 $source .= <<EOF;
378 {
379 dSP;
380 dPOPTOPssrl;
381 EOF
382 $source .= " SV *temp = left; left = right; right = temp;\n"
383 if $op->private & B::OPpASSIGN_BACKWARDS;
384
385 if ($insn->{follows_padsv_lval_intro} && !($op->private & B::OPpASSIGN_BACKWARDS)) {
386 # simple assignment - the target exists, but is basically undef
387 $source .= " SvSetSV (right, left);\n";
388 } else {
389 $source .= " SvSetMagicSV (right, left);\n";
390 }
391
392 $source .= <<EOF;
393 SETs (right);
394 PUTBACK;
395 }
396 EOF
397
398 out_next;
399 }
400
401 # pattern const+ (or general push1)
402 # pattern pushmark gv rv2av pushmark padsv+o.รค. aassign
403
404 sub op_method_named {
405 if ($insn->{follows_const}) {
406 $source .= <<EOF;
407 {
408 dSP;
409 static SV *last_cv;
410 static U32 last_sub_generation;
411
412 /* simple "polymorphic" inline cache */
413 if (PL_sub_generation == last_sub_generation)
414 {
415 PUSHs (last_cv);
416 PUTBACK;
417 }
418 else
419 {
420 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
421
422 SPAGAIN;
423 last_sub_generation = PL_sub_generation;
424 last_cv = TOPs;
425 }
426 }
427 EOF
428 } else {
429 $source .= <<EOF;
430 {
431 static HV *last_stash;
432 static SV *last_cv;
433 static U32 last_sub_generation;
434
435 SV *obj = *(PL_stack_base + TOPMARK + 1);
436
437 if (!SvGMAGICAL (obj) && SvROK (obj) && SvOBJECT (SvRV (obj)))
438 {
439 dSP;
440 HV *stash = SvSTASH (SvRV (obj));
441
442 /* simple "polymorphic" inline cache */
443 if (stash == last_stash
444 && PL_sub_generation == last_sub_generation)
445 {
446 PUSHs (last_cv);
447 PUTBACK;
448 }
449 else
450 {
451 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
452
453 SPAGAIN;
454 last_sub_generation = PL_sub_generation;
455 last_stash = stash;
456 last_cv = TOPs;
457 }
458 }
459 else
460 {
461 /* error case usually */
462 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
463 }
464 }
465 EOF
466 }
467
468 out_next;
469 }
470
471 sub op_grepstart {
472 out_callop;
473 $op = $op->next;
474 out_cond_jump $op->other;
475 out_jump_next;
476 }
477
478 *op_mapstart = \&op_grepstart;
479
480 sub op_substcont {
481 out_callop;
482 out_cond_jump $op->other->pmreplstart;
483 assert "nextop == (OP *)${$op->other->next}L";
484 $source .= " goto op_${$op->other->next};\n";
485 }
486
487 sub out_break_op {
488 my ($idx) = @_;
489
490 out_callop;
491
492 out_cond_jump $_->[$idx]
493 for reverse @op_loop;
494
495 $source .= " return nextop;\n";
496 }
497
498 sub xop_next {
499 out_break_op 0;
500 }
501
502 sub op_last {
503 out_break_op 1;
504 }
505
506 sub xop_redo {
507 out_break_op 2;
508 }
509
510 sub cv2c {
511 my ($cv) = @_;
512
513 local @ops;
514 local @op_loop;
515 local %op_regcomp;
516
517 my %opsseen;
518 my @todo = $cv->START;
519 my %op_target;
520 my $numpushmark;
521
522 while (my $op = shift @todo) {
523 for (; $$op; $op = $op->next) {
524 last if $opsseen{$$op}++;
525
526 my $name = $op->name;
527 my $class = B::class $op;
528
529 my $insn = { op => $op };
530
531 push @ops, $insn;
532
533 if (exists $extend{$name}) {
534 my $extend = $extend{$name};
535 $extend = $extend->($op) if ref $extend;
536 $insn->{extend} = $extend if defined $extend;
537 }
538
539 push @todo, $op->next;
540
541 if ($class eq "LOGOP") {
542 push @todo, $op->other;
543 $op_target{${$op->other}}++;
544
545 # regcomp/o patches ops at runtime, lets expect that
546 if ($name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP) {
547 $op_target{${$op->first}}++;
548 $op_regcomp{${$op->first}} = $op->next;
549 }
550
551 } elsif ($class eq "PMOP") {
552 if (${$op->pmreplstart}) {
553 unshift @todo, $op->pmreplstart;
554 $op_target{${$op->pmreplstart}}++;
555 }
556
557 } elsif ($class eq "LOOP") {
558 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next);
559
560 push @op_loop, \@targ;
561 push @todo, @targ;
562
563 $op_target{$$_}++ for @targ;
564
565 } elsif ($class eq "COP") {
566 $insn->{bblock}++ if defined $op->label;
567
568 } else {
569 if ($name eq "pushmark") {
570 $numpushmark++;
571 }
572 }
573 }
574 }
575
576 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
577
578 local $source = <<EOF;
579 OP *%%%FUNC%%% (pTHX)
580 {
581 register OP *nextop = (OP *)${$ops[0]->{op}}L;
582 EOF
583
584 $source .= " faster_PUSHMARK_PREALLOC ($numpushmark);\n"
585 if $numpushmark;
586
587 while (@ops) {
588 $insn = shift @ops;
589
590 $op = $insn->{op};
591 $op_name = $op->name;
592
593 my $class = B::class $op;
594
595 $source .= "\n/* start basic block */\n" if exists $insn->{bblock};#d#
596 $source .= "op_$$op: /* $op_name */\n";
597 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
598 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
599
600 $source .= " PERL_ASYNC_CHECK ();\n"
601 unless exists $f_noasync{$op_name};
602
603 if (my $can = __PACKAGE__->can ("op_$op_name")) {
604 # handcrafted replacement
605
606 if ($insn->{extend} > 0) {
607 # coalesce EXTENDs
608 # TODO: properly take negative preceeding and following EXTENDs into account
609 for my $i (@ops) {
610 last if exists $i->{bblock};
611 last unless exists $i->{extend};
612 my $extend = delete $i->{extend};
613 $insn->{extend} += $extend if $extend > 0;
614 }
615
616 $source .= " { dSP; EXTEND (SP, $insn->{extend}); PUTBACK; }\n"
617 if $insn->{extend} > 0;
618 }
619
620 $can->($op);
621
622 } elsif (exists $f_unsafe{$op_name}) {
623 # unsafe, return to interpreter
624 assert "nextop == (OP *)$$op";
625 $source .= " return nextop;\n";
626
627 } elsif ("LOGOP" eq $class) {
628 # logical operation with optional branch
629 out_callop;
630 out_cond_jump $op->other;
631 out_jump_next;
632
633 } elsif ("PMOP" eq $class) {
634 # regex-thingy
635 out_callop;
636 out_cond_jump $op->pmreplroot if $op_name ne "pushre" && ${$op->pmreplroot};
637 out_jump_next;
638
639 } else {
640 # normal operator, linear execution
641 out_linear;
642 }
643 }
644
645 $op_name = "func exit"; assert (0);
646
647 $source .= <<EOF;
648 op_0:
649 return 0;
650 }
651 EOF
652 #warn $source;
653
654 $source
655 }
656
657 my $uid = "aaaaaaa0";
658 my %so;
659
660 sub func2ptr {
661 my (@func) = @_;
662
663 #LOCK
664 mkdir $CACHEDIR, 0777;
665 sysopen my $meta_fh, "$CACHEDIR/meta", &Fcntl::O_RDWR | &Fcntl::O_CREAT, 0666
666 or die "$$CACHEDIR/meta: $!";
667 binmode $meta_fh, ":raw:perlio";
668 fcntl_lock fileno $meta_fh
669 or die "$CACHEDIR/meta: $!";
670
671 my $meta = eval { Storable::fd_retrieve $meta_fh } || { version => 1 };
672
673 for my $f (@func) {
674 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
675 $f->{so} = $meta->{$f->{func}};
676 }
677
678 if (grep !$_->{so}, @func) {
679 my $stem;
680
681 do {
682 $stem = "$CACHEDIR/$$-" . $uid++;
683 } while -e "$stem$_so";
684
685 open my $fh, ">:raw", "$stem.c";
686 print $fh <<EOF;
687 #define PERL_NO_GET_CONTEXT
688 #define PERL_CORE
689
690 #include <assert.h>
691
692 #include "EXTERN.h"
693 #include "perl.h"
694 #include "XSUB.h"
695
696 #if 1
697 # define faster_PUSHMARK_PREALLOC(count) while (PL_markstack_ptr + (count) >= PL_markstack_max) markstack_grow ()
698 # define faster_PUSHMARK(p) *++PL_markstack_ptr = (p) - PL_stack_base
699 #else
700 # define faster_PUSHMARK_PREALLOC(count) 1
701 # define faster_PUSHMARK(p) PUSHMARK(p)
702 #endif
703
704 #define RUNOPS_TILL(op) \\
705 while (nextop != (op)) \\
706 { \\
707 PERL_ASYNC_CHECK (); \\
708 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
709 }
710
711 EOF
712 for my $f (grep !$_->{so}, @func) {
713 next if $f->{so} = $meta->{$f->{func}}; # some cv's alias others
714
715 warn "compiling $f->{name} to $stem$_so:$f->{func}\n" if $verbose > 1;
716 my $source = $f->{source};
717 $source =~ s/%%%FUNC%%%/$f->{func}/g;
718 print $fh $source;
719 $meta->{$f->{func}} = $f->{so} = $stem;
720 }
721
722 close $fh;
723 system "$COMPILE -o $stem$_o $stem.c";
724 unlink "$stem.c" unless $ENV{FASTER_DEBUG} > 0;
725 system "$LINK -o $stem$_so $stem$_o $LIBS";
726 unlink "$stem$_o";
727 }
728
729 for my $f (@func) {
730 my $stem = $f->{so};
731
732 my $so = ($so{$stem} ||= DynaLoader::dl_load_file "$stem$_so")
733 or die "$stem$_so: $!";
734
735 #unlink "$stem$_so";
736
737 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
738 or die "$f->{func} not found in $stem$_so: $!";
739 }
740
741 seek $meta_fh, 0, 0 or die "$CACHEDIR/meta: $!";
742 Storable::nstore_fd $meta, $meta_fh;
743 truncate $meta_fh, tell $meta_fh;
744
745 # UNLOCK (by closing $meta_fh)
746 }
747
748 my %ignore;
749
750 sub entersub {
751 my ($cv) = @_;
752
753 my $pkg = $cv->STASH->NAME;
754
755 return if $ignore{$pkg};
756
757 warn "optimising ", $cv->STASH->NAME, "\n"
758 if $verbose;
759
760 eval {
761 my @func;
762
763 push @func, {
764 cv => $cv,
765 name => "<>",
766 source => cv2c $cv,
767 };
768
769 # always compile the whole stash
770 my %stash = $cv->STASH->ARRAY;
771 while (my ($k, $v) = each %stash) {
772 $v->isa (B::GV::)
773 or next;
774
775 my $cv = $v->CV;
776
777 if ($cv->isa (B::CV::)
778 && ${$cv->START}
779 && $cv->START->name ne "null") {
780
781 push @func, {
782 cv => $cv,
783 name => $k,
784 source => cv2c $cv,
785 };
786 }
787 }
788
789 func2ptr @func;
790
791 for my $f (@func) {
792 patch_cv $f->{cv}, $f->{ptr};
793 }
794 };
795
796 if ($@) {
797 $ignore{$pkg}++;
798 warn $@;
799 }
800 }
801
802 hook_entersub;
803
804 1;
805
806 =back
807
808 =head1 ENVIRONMENT VARIABLES
809
810 The following environment variables influence the behaviour of Faster:
811
812 =over 4
813
814 =item FASTER_VERBOSE
815
816 Faster will output more informational messages when set to values higher
817 than C<0>. Currently, C<1> outputs which packages are being compiled, C<3>
818 outputs the cache directory and C<10> outputs information on which perl
819 function is compiled into which shared object.
820
821 =item FASTER_DEBUG
822
823 Add debugging code when set to values higher than C<0>. Currently, this
824 adds 1-3 C<assert>'s per perl op (FASTER_DEBUG > 1), to ensure that opcode
825 order and C execution order are compatible.
826
827 =item FASTER_CACHE
828
829 Set a persistent cache directory that caches compiled code fragments. The
830 default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary
831 directory otherwise.
832
833 This directory will always grow in size, so you might need to erase it
834 from time to time.
835
836 =back
837
838 =head1 BUGS/LIMITATIONS
839
840 Perl will check much less often for asynchronous signals in
841 Faster-compiled code. It tries to check on every function call, loop
842 iteration and every I/O operator, though.
843
844 The following things will disable Faster. If you manage to enable them at
845 runtime, bad things will happen. Enabling them at startup will be fine,
846 though.
847
848 enabled tainting
849 enabled debugging
850
851 Thread-enabled builds of perl will dramatically reduce Faster's
852 performance, but you don't care about speed if you enable threads anyway.
853
854 These constructs will force the use of the interpreter for the currently
855 executed function as soon as they are being encountered during execution.
856
857 goto
858 next, redo (but not well-behaved last's)
859 eval
860 require
861 any use of formats
862 .., ... (flipflop operators)
863
864 =head1 AUTHOR
865
866 Marc Lehmann <schmorp@schmorp.de>
867 http://home.schmorp.de/
868
869 =cut
870