=head1 NAME

Faster - do some things faster

=head1 SYNOPSIS

 use Faster;

=head1 DESCRIPTION

=over 4

=cut

package Faster;

use strict;

BEGIN {
   our $VERSION = '0.01';

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

use B ();

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
EOF
   my (undef, $op, @flags) = split /\s+/;

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

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

   $source .= "  PL_op = (OP *)${$op->next}L;\n";
   $source .= "  goto op_${$op->next};\n";
}

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

   $source .= "  PL_curcop = (COP *)PL_op;\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;
}

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

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

   my $ppaddr = ppaddr $op->type;

   $source .= <<EOF;
  {
    dSP;

    if (SvROK (TOPm1s) && SvOBJECT (SvRV (TOPm1s)))
      {
        static SV *last_stash, SV *last_res;
        SV *stash = SvSTASH (SvRV (TOPm1s));

        // simple polymorphic inline cache
        if (stash == last_stash)
          {
            dTARGET;
            SETTARG (last_res);
          }
        else
          {
            PUTBACK;
            ((PPFUNC)${ppaddr}L)(aTHX);\n";
            SPAGAIN;

            last_stash = stash;
            last_res   = TOPs;
          }
      }
  }
EOF

   out_next $op;
}

sub entersub {
   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;

   $source = "typedef OP *(*PPFUNC)(pTHX);\n\n";
   
   $source .= "OP *func (pTHX)\n{\n  dTHX;\n";

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

      $source .= "op_$$op: /* $name */\n";

      if (my $can = __PACKAGE__->can ("op_$name")) {
         $can->($op);
      } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
         $source .= "  PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
         $source .= "  if (PL_op == (OP *)${$op->other}L) goto op_${$op->other};\n";
         $source .= "  goto op_${$op->next};\n";
      } elsif (exists $flag{unsafe}{$name}) {
         $source .= "  return ((PPFUNC)${ppaddr}L)(aTHX);\n";
      } else {
         $source .= "  PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
         $source .= "  goto op_${$op->next};\n";
      }
   }

   $source .= "}\n";

   print <<EOF;
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
EOF
   print $source;
}

hook_entersub;

1;

=back

=head1 LIMITATIONS

Tainting and debugging will disable Faster.

=head1 AUTHOR

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

=cut