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