ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
Revision: 1.3
Committed: Thu Mar 9 06:35:33 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.2: +58 -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 $source .= " PL_op = (OP *)${$op->next}L;\n";
61 $source .= " goto op_${$op->next};\n";
62 }
63
64 sub op_nextstate {
65 my ($op) = @_;
66
67 $source .= " PL_curcop = (COP *)PL_op;\n";
68 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
69 $source .= " FREETMPS;\n";
70
71 out_next $op;
72 }
73
74 sub op_pushmark {
75 my ($op) = @_;
76
77 $source .= " PUSHMARK (PL_stack_sp);\n";
78
79 out_next $op;
80 }
81
82 sub op_const {
83 my ($op) = @_;
84
85 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
86
87 out_next $op;
88 }
89
90 *op_gv = \&op_const;
91
92 sub op_stringify {
93 my ($op) = @_;
94
95 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
96
97 out_next $op;
98 }
99
100 # pattern const+ (or general push1)
101 # pattern pushmark return(?)
102 # pattern pushmark gv rv2av pushmark padsv+o.รค. aassign
103
104 # pattern const method_named
105 sub xop_method_named {
106 my ($op) = @_;
107
108 my $ppaddr = ppaddr $op->type;
109
110 $source .= <<EOF;
111 {
112 dSP;
113
114 if (SvROK (TOPm1s) && SvOBJECT (SvRV (TOPm1s)))
115 {
116 static SV *last_stash, SV *last_res;
117 SV *stash = SvSTASH (SvRV (TOPm1s));
118
119 // simple polymorphic inline cache
120 if (stash == last_stash)
121 {
122 dTARGET;
123 SETTARG (last_res);
124 }
125 else
126 {
127 PUTBACK;
128 ((PPFUNC)${ppaddr}L)(aTHX);\n";
129 SPAGAIN;
130
131 last_stash = stash;
132 last_res = TOPs;
133 }
134 }
135 }
136 EOF
137
138 out_next $op;
139 }
140
141 sub entersub {
142 my ($cv) = @_;
143
144 my %opsseen;
145 my @ops;
146 my @todo = $cv->START;
147
148 while (my $op = shift @todo) {
149 for (; $$op; $op = $op->next) {
150 last if $opsseen{$$op}++;
151 push @ops, $op;
152 my $name = $op->name;
153 if (B::class($op) eq "LOGOP") {
154 push @todo, $op->other;
155 } elsif ($name eq "subst" and ${ $op->pmreplstart }) {
156 push @todo, $op->pmreplstart;
157 } elsif ($name =~ /^enter(loop|iter)$/) {
158 # if ($] > 5.009) {
159 # $labels{${$op->nextop}} = "NEXT";
160 # $labels{${$op->lastop}} = "LAST";
161 # $labels{${$op->redoop}} = "REDO";
162 # } else {
163 # $labels{$op->nextop->seq} = "NEXT";
164 # $labels{$op->lastop->seq} = "LAST";
165 # $labels{$op->redoop->seq} = "REDO";
166 # }
167 }
168 }
169 }
170
171 local $source;
172
173 $source = "typedef OP *(*PPFUNC)(pTHX);\n\n";
174
175 $source .= "OP *func (pTHX)\n{\n dTHX;\n";
176
177 for my $op (@ops) {
178 my $name = $op->name;
179 my $ppaddr = ppaddr $op->type;
180
181 $source .= "op_$$op: /* $name */\n";
182
183 if (my $can = __PACKAGE__->can ("op_$name")) {
184 $can->($op);
185 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
186 $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
187 $source .= " if (PL_op == (OP *)${$op->other}L) goto op_${$op->other};\n";
188 $source .= " goto op_${$op->next};\n";
189 } elsif (exists $flag{unsafe}{$name}) {
190 $source .= " return ((PPFUNC)${ppaddr}L)(aTHX);\n";
191 } else {
192 $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n";
193 $source .= " goto op_${$op->next};\n";
194 }
195 }
196
197 $source .= "}\n";
198
199 print <<EOF;
200 #include "EXTERN.h"
201 #include "perl.h"
202 #include "XSUB.h"
203 EOF
204 print $source;
205 }
206
207 hook_entersub;
208
209 1;
210
211 =back
212
213 =head1 LIMITATIONS
214
215 Tainting and debugging will disable Faster.
216
217 =head1 AUTHOR
218
219 Marc Lehmann <schmorp@schmorp.de>
220 http://home.schmorp.de/
221
222 =cut
223