ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
Revision: 1.2
Committed: Thu Mar 9 06:03:12 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.1: +90 -3 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 =head1 DESCRIPTION
10
11 =over 4
12
13 =cut
14
15 package Faster;
16
17 use strict;
18
19 BEGIN {
20 our $VERSION = '0.01';
21
22 require XSLoader;
23 XSLoader::load __PACKAGE__, $VERSION;
24 }
25
26 use B ();
27
28 our $source;
29 our $label_next;
30 our $label_last;
31 our $label_redo;
32
33 my %flag;
34
35 for (split /\n/, <<EOF) {
36 leavesub unsafe
37 leavesublv unsafe
38 return unsafe
39 flip unsafe
40 goto unsafe
41 last unsafe
42 redo unsafe
43 next unsafe
44 eval unsafe
45 leaveeval unsafe
46 entertry unsafe
47 substconst unsafe
48 formline unsafe
49 grepstart unsafe
50 EOF
51 my (undef, $op, @flags) = split /\s+/;
52
53 undef $flag{$_}{$op}
54 for ("known", @flags);
55 }
56
57 sub out_next {
58 my ($op) = @_;
59
60 my $ppaddr = ppaddr $op->type;
61
62 $source .= " PL_op = (OP *)${$op->next}L;\n";
63 $source .= " goto op_${$op->next};\n";
64 }
65
66 sub op_nextstate {
67 my ($op) = @_;
68
69 $source .= " PL_curcop = (COP *)PL_op;\n";
70 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
71 $source .= " FREETMPS;\n";
72
73 out_next $op;
74 }
75
76 sub op_const {
77 my ($op) = @_;
78
79 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
80
81 out_next $op;
82 }
83
84 *op_gv = \&op_const;
85
86 sub entersub {
87 my ($cv) = @_;
88
89 my %opsseen;
90 my @ops;
91 my @todo = $cv->START;
92
93 while (my $op = shift @todo) {
94 for (; $$op; $op = $op->next) {
95 last if $opsseen{$$op}++;
96 push @ops, $op;
97 my $name = $op->name;
98 if (B::class($op) eq "LOGOP") {
99 push @todo, $op->other;
100 } elsif ($name eq "subst" and ${ $op->pmreplstart }) {
101 push @todo, $op->pmreplstart;
102 } elsif ($name =~ /^enter(loop|iter)$/) {
103 # if ($] > 5.009) {
104 # $labels{${$op->nextop}} = "NEXT";
105 # $labels{${$op->lastop}} = "LAST";
106 # $labels{${$op->redoop}} = "REDO";
107 # } else {
108 # $labels{$op->nextop->seq} = "NEXT";
109 # $labels{$op->lastop->seq} = "LAST";
110 # $labels{$op->redoop->seq} = "REDO";
111 # }
112 }
113 }
114 }
115
116 local $source;
117
118 $source = "typedef OP *(*PPFUNC)(pTHX);\n\n";
119
120 $source .= "OP *func (pTHX)\n{\n";
121
122 for my $op (@ops) {
123 my $name = $op->name;
124 my $ppaddr = ppaddr $op->type;
125
126 $source .= "op_$$op: /* $name */\n";
127
128 if (my $can = __PACKAGE__->can ("op_$name")) {
129 $can->($op);
130 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
131 $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
132 $source .= " if (PL_op == (OP *)${$op->other}L) goto op_${$op->other};\n";
133 $source .= " goto op_${$op->next};\n";
134 } elsif (exists $flag{unsafe}{$name}) {
135 $source .= " return ((PPFUNC)${ppaddr}L)(aTHX);\n";
136 } else {
137 $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
138 $source .= " goto op_${$op->next};\n";
139 }
140 }
141
142 $source .= "}\n";
143
144 print <<EOF;
145 #include "EXTERN.h"
146 #include "perl.h"
147 #include "XSUB.h"
148 EOF
149 print $source;
150 }
151
152 hook_entersub;
153
154 1;
155
156 =back
157
158 =head1 LIMITATIONS
159
160 Tainting and debugging will disable Faster.
161
162 =head1 AUTHOR
163
164 Marc Lehmann <schmorp@schmorp.de>
165 http://home.schmorp.de/
166
167 =cut
168