Faster/Faster.pm

=head1 NAME

Faster - do some things faster

=head1 SYNOPSIS

 use Faster;

=head1 DESCRIPTION

=over 4

=cut

package Faster;

use strict;
use Config;
use B ();
use Digest::MD5 ();
use DynaLoader ();

BEGIN {
   our $VERSION = '0.01';

   require XSLoader;
   XSLoader::load __PACKAGE__, $VERSION;
}

my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
my $LINK    = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
my $LIBS    = "$Config{libs}";
my $_o      = $Config{_o};
my $_so     = ".so";

our $source;
our $label_next;
our $label_last;
our $label_redo;

my %flag;

for (split /\n/, <<EOF) {
   leavesub     unsafe
   leavesublv   unsafe
   return       unsafe
   flip         unsafe
   goto         unsafe
   last         unsafe
   redo         unsafe
   next         unsafe
   eval         unsafe
   leaveeval    unsafe
   entertry     unsafe
   substconst   unsafe
   formline     unsafe
   grepstart    unsafe
   require      unsafe
   match        unsafe  todo
   subst        unsafe  todo
   entereval    unsafe  todo
   mapstart     unsafe  todo

   pushmark     noasync
   padsv        noasync
   entersub     noasync
   aassign      noasync
   sassign      noasync
   rv2av        noasync
   nextstate    noasync
   gv           noasync
   gvsv         noasync
   add          noasync
   subtract     noasync
   multiply     noasync
   divide       noasync
   complement   noasync
   cond_expr    noasync
   and          noasync
   or           noasync
   not          noasync
   method_named noasync
   preinc       noasync
   postinc      noasync
   predec       noasync
   postdec      noasync
   stub         noasync
   unstack      noasync
   leaveloop    noasync
   shift        noasync
   aelemA       noasync
   aelemfast    noasync 
EOF
   my (undef, $op, @flags) = split /\s+/;

   undef $flag{$_}{$op}
      for ("known", @flags);
}

sub out_next {
   my ($op) = @_;

   if (${$op->next}) {
      $source .= "  nextop = (OP *)${$op->next}L;\n";
      $source .= "  goto op_${$op->next};\n";
   } else {
      $source .= "  return 0;\n";
   }
}

sub callop {
   my ($op) = @_;

   my $name = $op->name;

   $name eq "entersub"
      ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)"
      : $name eq "mapstart"
        ? "Perl_pp_grepstart (aTHX)"
        : "Perl_pp_$name (aTHX)"
}

sub op_nextstate {
   my ($op) = @_;

   $source .= "  PL_curcop = (COP *)nextop;\n";
   $source .= "  PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
   $source .= "  FREETMPS;\n";

   out_next $op;
}

sub op_pushmark {
   my ($op) = @_;

   $source .= "  PUSHMARK (PL_stack_sp);\n";

   out_next $op;
}

sub op_const {
   my ($op) = @_;

   $source .= "  { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";

   out_next $op;
}

*op_gv = \&op_const;

sub op_stringify {
   my ($op) = @_;

   $source .= "  { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";

   out_next $op;
}

sub op_and {
   my ($op) = @_;

   $source .= <<EOF;
  {
    dSP;

    if (SvTRUE (TOPs))
      {
        --SP;
        PUTBACK;
        nextop = (OP *)${$op->other}L;
        goto op_${$op->other};
      }
  }
EOF

   out_next $op;
}

sub op_or {
   my ($op) = @_;

   $source .= <<EOF;
  {
    dSP;

    if (!SvTRUE (TOPs))
      {
        --SP;
        PUTBACK;
        nextop = (OP *)${$op->other}L;
        goto op_${$op->other};
      }
  }
EOF

   out_next $op;
}

sub op_padsv {
   my ($op) = @_;

   my $flags = $op->flags;
   my $target = $op->targ;

   $source .= <<EOF;
  {
    dSP;
    XPUSHs (PAD_SV ((PADOFFSET)$target));
    PUTBACK;
EOF
   if ($op->flags & B::OPf_MOD) {
      if ($op->private & B::OPpLVAL_INTRO) {
         $source .= "    SAVECLEARSV (PAD_SVl ((PADOFFSET)$target));\n";
      } elsif ($op->private & B::OPpDEREF) {
         my $deref = $op->private & B::OPpDEREF;
         $source .= "    Perl_vivify_ref (PAD_SVl ((PADOFFSET)$target), $deref);\n";
      }
   }
   $source .= <<EOF;
  }
EOF

   out_next $op;
}

sub op_aelemfast {
   my ($op) = @_;

   my $targ = $op->targ;
   my $private = $op->private;

   $source .= "  {\n";

   if ($op->flags & B::OPf_SPECIAL) {
      $source .= "    AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
   } else {
      $source .= "    AV *av = GvAV ((GV *)${$op->sv}L);\n";
   }

   if ($op->flags & B::OPf_MOD) {
      $source .= "    SV *sv = *av_fetch (av, $private, 1);\n";
   } else {
      $source .= "    SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
   }

   if (!($op->flags & B::OPf_MOD)) {
      $source .= "    if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
   }

   $source .= "    dSP;\n";
   $source .= "    XPUSHs (sv);\n";
   $source .= "    PUTBACK;\n";
   $source .= "  }\n";

   out_next $op;
}

# pattern const+ (or general push1)
# pattern pushmark return(?)
# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign

# pattern const method_named
sub op_method_named {
   my ($op) = @_;

   $source .= <<EOF;
  {
    static HV *last_stash;
    static SV *last_res;

    SV *obj = *(PL_stack_base + TOPMARK + 1);

    if (SvROK (obj) && SvOBJECT (SvRV (obj)))
      {
        dSP;
        HV *stash = SvSTASH (SvRV (obj));

        /* simple "polymorphic" inline cache */
        if (stash == last_stash)
          {
            XPUSHs (last_res);
            PUTBACK;
          }
        else
          {
            PL_op = nextop;
            nextop = Perl_pp_method_named (aTHX);

            SPAGAIN;
            last_stash = stash;
            last_res   = TOPs;
          }
      }
    else
      {
        /* error case usually */
        PL_op = nextop;
        nextop = Perl_pp_method_named (aTHX);
      }
  }
EOF

   out_next $op;
}

sub cv2c {
   my ($cv) = @_;

   my %opsseen;
   my @ops;
   my @todo = $cv->START;

   while (my $op = shift @todo) {
      for (; $$op; $op = $op->next) {
         last if $opsseen{$$op}++;
         push @ops, $op;
         my $name = $op->name;
         if (B::class($op) eq "LOGOP") {
            push @todo, $op->other;
         } elsif ($name eq "subst" and ${ $op->pmreplstart }) {
            push @todo, $op->pmreplstart;
         } elsif ($name =~ /^enter(loop|iter)$/) {
#            if ($] > 5.009) {
#               $labels{${$op->nextop}} = "NEXT";
#               $labels{${$op->lastop}} = "LAST";
#               $labels{${$op->redoop}} = "REDO";
#            } else {
#               $labels{$op->nextop->seq} = "NEXT";
#               $labels{$op->lastop->seq} = "LAST";
#               $labels{$op->redoop->seq} = "REDO";         
#            }
         }
      }
   }

   local $source = <<EOF;
#define PERL_NO_GET_CONTEXT

#include <assert.h>

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/*typedef OP *(*PPFUNC)(pTHX);*/
   
OP *%%%FUNC%%% (pTHX)
{
  register OP *nextop = (OP *)${$ops[0]}L;
EOF

   for my $op (@ops) {
      my $name = $op->name;
      my $ppaddr = ppaddr $op->type;

      $source .= "op_$$op: /* $name */\n";
      #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d#
      #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#

      unless (exists $flag{noasync}{$name}) {
         $source .= "  PERL_ASYNC_CHECK ();\n";
      }

      if (my $can = __PACKAGE__->can ("op_$name")) {
         $can->($op);
      } elsif (exists $flag{unsafe}{$name}) {
         $source .= "  assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
         $source .= "  PL_op = nextop; return " . (callop $op) . ";\n";
      } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
         $source .= "  assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
         $source .= "  PL_op = nextop; nextop = " . (callop $op) . ";\n";
         $source .= "  if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
         $source .= "  assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
         $source .= ${$op->next} ? "  goto op_${$op->next};\n" : "  return 0;\n";
      } else {
         $source .= "  assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
         $source .= "  PL_op = nextop; nextop = " . (callop $op) . ";\n";
         if ($name eq "entersub") {
            $source .= <<EOF;
while (nextop != (OP *)${$op->next})
  {
    PERL_ASYNC_CHECK ();
    PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
  }
EOF
         }
         $source .= "  assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
         $source .= ${$op->next} ? "  goto op_${$op->next};\n" : "  return 0;\n";
      }
   }

   $source .= "}\n";
   #warn $source;

   $source
}

sub source2ptr {
   my ($source) = @_;

   my $md5 = Digest::MD5::md5_hex $source;
   $source =~ s/%%%FUNC%%%/Faster_$md5/;

   my $stem = "/tmp/$md5";

   unless (-e "$stem$_so") {
      open FILE, ">:raw", "$stem.c";
      print FILE $source;
      close FILE;
      system "$COMPILE -o $stem$_o $stem.c";
      system "$LINK -o $stem$_so $stem$_o $LIBS";
   }

#   warn $source;
   my $so = DynaLoader::dl_load_file "$stem$_so"
      or die "$stem$_so: $!";

   DynaLoader::dl_find_symbol $so, "Faster_$md5"
      or die "Faster_$md5: $!"
}

sub entersub {
   my ($cv) = @_;

   eval {
      my $source = cv2c $cv;

       my $ptr = source2ptr $source;

       patch_cv $cv, $ptr;
   };

   warn $@ if $@;
}

hook_entersub;

1;

=back

=head1 LIMITATIONS

Tainting and debugging will disable Faster.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.7
Committed:	Fri Mar 10 00:13:15 2006 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.6:	+20 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Faster - do some things faster
4
5			=head1 SYNOPSIS
6
7			use Faster;
8
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15			package Faster;
16
17			use strict;
18	root	1.4	use Config;
19			use B ();
20			use Digest::MD5 ();
21			use DynaLoader ();
22	root	1.1
23			BEGIN {
24			our $VERSION = '0.01';
25
26			require XSLoader;
27			XSLoader::load __PACKAGE__, $VERSION;
28			}
29
30	root	1.4	my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
31			my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
32			my $LIBS = "$Config{libs}";
33			my $_o = $Config{_o};
34			my $_so = ".so";
35	root	1.1
36			our $source;
37			our $label_next;
38			our $label_last;
39			our $label_redo;
40
41	root	1.2	my %flag;
42
43			for (split /\n/, <<EOF) {
44			leavesub unsafe
45			leavesublv unsafe
46			return unsafe
47			flip unsafe
48			goto unsafe
49			last unsafe
50			redo unsafe
51			next unsafe
52			eval unsafe
53			leaveeval unsafe
54			entertry unsafe
55			substconst unsafe
56			formline unsafe
57			grepstart unsafe
58	root	1.4	require unsafe
59	root	1.5	match unsafe todo
60			subst unsafe todo
61			entereval unsafe todo
62			mapstart unsafe todo
63	root	1.4
64			pushmark noasync
65			padsv noasync
66			entersub noasync
67			aassign noasync
68			sassign noasync
69			rv2av noasync
70			nextstate noasync
71			gv noasync
72			gvsv noasync
73			add noasync
74			subtract noasync
75			multiply noasync
76			divide noasync
77			complement noasync
78			cond_expr noasync
79			and noasync
80			or noasync
81			not noasync
82			method_named noasync
83			preinc noasync
84			postinc noasync
85			predec noasync
86			postdec noasync
87			stub noasync
88			unstack noasync
89			leaveloop noasync
90			shift noasync
91			aelemA noasync
92			aelemfast noasync
93	root	1.2	EOF
94			my (undef, $op, @flags) = split /\s+/;
95
96			undef $flag{$_}{$op}
97			for ("known", @flags);
98			}
99
100			sub out_next {
101			my ($op) = @_;
102
103	root	1.5	if (${$op->next}) {
104			$source .= " nextop = (OP *)${$op->next}L;\n";
105			$source .= " goto op_${$op->next};\n";
106			} else {
107			$source .= " return 0;\n";
108			}
109	root	1.2	}
110
111	root	1.4	sub callop {
112			my ($op) = @_;
113
114			my $name = $op->name;
115
116			$name eq "entersub"
117			? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)"
118	root	1.5	: $name eq "mapstart"
119			? "Perl_pp_grepstart (aTHX)"
120			: "Perl_pp_$name (aTHX)"
121	root	1.4	}
122
123	root	1.2	sub op_nextstate {
124			my ($op) = @_;
125
126	root	1.4	$source .= " PL_curcop = (COP *)nextop;\n";
127	root	1.2	$source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
128			$source .= " FREETMPS;\n";
129
130			out_next $op;
131			}
132
133	root	1.3	sub op_pushmark {
134			my ($op) = @_;
135
136			$source .= " PUSHMARK (PL_stack_sp);\n";
137
138			out_next $op;
139			}
140
141	root	1.2	sub op_const {
142			my ($op) = @_;
143
144			$source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
145
146			out_next $op;
147			}
148
149			*op_gv = \&op_const;
150
151	root	1.3	sub op_stringify {
152			my ($op) = @_;
153
154			$source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
155
156			out_next $op;
157			}
158
159	root	1.4	sub op_and {
160			my ($op) = @_;
161
162			$source .= <<EOF;
163			{
164			dSP;
165	root	1.5
166	root	1.4	if (SvTRUE (TOPs))
167			{
168			--SP;
169			PUTBACK;
170			nextop = (OP *)${$op->other}L;
171			goto op_${$op->other};
172			}
173			}
174			EOF
175	root	1.5
176			out_next $op;
177	root	1.4	}
178
179	root	1.7	sub op_or {
180			my ($op) = @_;
181
182			$source .= <<EOF;
183			{
184			dSP;
185
186			if (!SvTRUE (TOPs))
187			{
188			--SP;
189			PUTBACK;
190			nextop = (OP *)${$op->other}L;
191			goto op_${$op->other};
192			}
193			}
194			EOF
195
196			out_next $op;
197			}
198
199	root	1.4	sub op_padsv {
200			my ($op) = @_;
201
202			my $flags = $op->flags;
203			my $target = $op->targ;
204
205			$source .= <<EOF;
206			{
207			dSP;
208			XPUSHs (PAD_SV ((PADOFFSET)$target));
209			PUTBACK;
210			EOF
211			if ($op->flags & B::OPf_MOD) {
212			if ($op->private & B::OPpLVAL_INTRO) {
213			$source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$target));\n";
214			} elsif ($op->private & B::OPpDEREF) {
215			my $deref = $op->private & B::OPpDEREF;
216			$source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$target), $deref);\n";
217			}
218			}
219			$source .= <<EOF;
220			}
221			EOF
222
223			out_next $op;
224			}
225
226	root	1.6	sub op_aelemfast {
227			my ($op) = @_;
228
229			my $targ = $op->targ;
230			my $private = $op->private;
231
232			$source .= " {\n";
233
234			if ($op->flags & B::OPf_SPECIAL) {
235			$source .= " AV av = (AV)PAD_SV((PADOFFSET)$targ);\n";
236			} else {
237			$source .= " AV av = GvAV ((GV )${$op->sv}L);\n";
238			}
239
240			if ($op->flags & B::OPf_MOD) {
241			$source .= " SV sv = av_fetch (av, $private, 1);\n";
242			} else {
243			$source .= " SV *svp = av_fetch (av, $private, 0); SV sv = svp ? *svp : &PL_sv_undef;\n";
244			}
245
246			if (!($op->flags & B::OPf_MOD)) {
247			$source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
248			}
249
250			$source .= " dSP;\n";
251			$source .= " XPUSHs (sv);\n";
252			$source .= " PUTBACK;\n";
253			$source .= " }\n";
254
255			out_next $op;
256			}
257
258	root	1.3	# pattern const+ (or general push1)
259			# pattern pushmark return(?)
260			# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
261
262			# pattern const method_named
263	root	1.4	sub op_method_named {
264	root	1.3	my ($op) = @_;
265
266			$source .= <<EOF;
267			{
268	root	1.4	static HV *last_stash;
269			static SV *last_res;
270
271			SV obj = (PL_stack_base + TOPMARK + 1);
272	root	1.3
273	root	1.4	if (SvROK (obj) && SvOBJECT (SvRV (obj)))
274	root	1.3	{
275	root	1.4	dSP;
276			HV *stash = SvSTASH (SvRV (obj));
277	root	1.3
278	root	1.4	/* simple "polymorphic" inline cache */
279	root	1.3	if (stash == last_stash)
280			{
281	root	1.4	XPUSHs (last_res);
282			PUTBACK;
283	root	1.3	}
284			else
285			{
286	root	1.4	PL_op = nextop;
287			nextop = Perl_pp_method_named (aTHX);
288
289	root	1.3	SPAGAIN;
290			last_stash = stash;
291			last_res = TOPs;
292			}
293			}
294	root	1.4	else
295			{
296			/* error case usually */
297			PL_op = nextop;
298			nextop = Perl_pp_method_named (aTHX);
299			}
300	root	1.3	}
301			EOF
302
303			out_next $op;
304			}
305
306	root	1.4	sub cv2c {
307	root	1.1	my ($cv) = @_;
308
309			my %opsseen;
310			my @ops;
311			my @todo = $cv->START;
312
313			while (my $op = shift @todo) {
314			for (; $$op; $op = $op->next) {
315			last if $opsseen{$$op}++;
316			push @ops, $op;
317			my $name = $op->name;
318			if (B::class($op) eq "LOGOP") {
319			push @todo, $op->other;
320			} elsif ($name eq "subst" and ${ $op->pmreplstart }) {
321			push @todo, $op->pmreplstart;
322			} elsif ($name =~ /^enter(loop\|iter)$/) {
323			# if ($] > 5.009) {
324			# $labels{${$op->nextop}} = "NEXT";
325			# $labels{${$op->lastop}} = "LAST";
326			# $labels{${$op->redoop}} = "REDO";
327			# } else {
328			# $labels{$op->nextop->seq} = "NEXT";
329			# $labels{$op->lastop->seq} = "LAST";
330			# $labels{$op->redoop->seq} = "REDO";
331			# }
332			}
333			}
334			}
335
336	root	1.4	local $source = <<EOF;
337			#define PERL_NO_GET_CONTEXT
338
339			#include <assert.h>
340
341			#include "EXTERN.h"
342			#include "perl.h"
343			#include "XSUB.h"
344	root	1.2
345	root	1.4	/typedef OP (PPFUNC)(pTHX);/
346	root	1.2
347	root	1.4	OP *%%%FUNC%%% (pTHX)
348			{
349			register OP nextop = (OP )${$ops[0]}L;
350			EOF
351	root	1.2
352			for my $op (@ops) {
353			my $name = $op->name;
354			my $ppaddr = ppaddr $op->type;
355
356			$source .= "op_$$op: /* $name */\n";
357	root	1.4	#$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d#
358			#$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
359
360			unless (exists $flag{noasync}{$name}) {
361			$source .= " PERL_ASYNC_CHECK ();\n";
362			}
363	root	1.2
364			if (my $can = __PACKAGE__->can ("op_$name")) {
365			$can->($op);
366	root	1.5	} elsif (exists $flag{unsafe}{$name}) {
367			$source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
368			$source .= " PL_op = nextop; return " . (callop $op) . ";\n";
369	root	1.2	} elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
370	root	1.4	$source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
371			$source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
372			$source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
373			$source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
374	root	1.5	$source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
375	root	1.2	} else {
376	root	1.4	$source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
377			$source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
378			if ($name eq "entersub") {
379			$source .= <<EOF;
380			while (nextop != (OP *)${$op->next})
381			{
382			PERL_ASYNC_CHECK ();
383			PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
384			}
385			EOF
386			}
387			$source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
388	root	1.5	$source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
389	root	1.2	}
390	root	1.1	}
391	root	1.2
392			$source .= "}\n";
393	root	1.4	#warn $source;
394	root	1.2
395	root	1.4	$source
396			}
397
398			sub source2ptr {
399			my ($source) = @_;
400
401			my $md5 = Digest::MD5::md5_hex $source;
402			$source =~ s/%%%FUNC%%%/Faster_$md5/;
403
404			my $stem = "/tmp/$md5";
405
406			unless (-e "$stem$_so") {
407			open FILE, ">:raw", "$stem.c";
408			print FILE $source;
409			close FILE;
410			system "$COMPILE -o $stem$_o $stem.c";
411			system "$LINK -o $stem$_so $stem$_o $LIBS";
412			}
413
414			# warn $source;
415			my $so = DynaLoader::dl_load_file "$stem$_so"
416			or die "$stem$_so: $!";
417
418			DynaLoader::dl_find_symbol $so, "Faster_$md5"
419			or die "Faster_$md5: $!"
420			}
421
422			sub entersub {
423			my ($cv) = @_;
424
425			eval {
426			my $source = cv2c $cv;
427
428			my $ptr = source2ptr $source;
429
430			patch_cv $cv, $ptr;
431			};
432
433			warn $@ if $@;
434	root	1.1	}
435
436			hook_entersub;
437
438			1;
439
440			=back
441
442	root	1.2	=head1 LIMITATIONS
443
444			Tainting and debugging will disable Faster.
445
446	root	1.1	=head1 AUTHOR
447
448			Marc Lehmann <schmorp@schmorp.de>
449			http://home.schmorp.de/
450
451			=cut
452